;lp$filt=0 ; defgine to prevent usr mode logical i/o to mounted dsks
; clnprv must not deallocate the LDT called from opnfilt...!!!
	.if	df,pcb$ar_natural_psb
;pcb$ar_natural_psb_def=0
	.endc
pcbmsk$$=0
evax = 1
alpha=1
bigpage=1
addressbits=32
step2=1
;msetrp=0	;turn mousetrap stuff on
;evxrei=0 ; try to REI to original PSL
;evxr64d=0	;macro-64 RET stuff
	.TITLE	JTDRiver	;skeleton driver implementing ucb linkage
	.IDENT	'V03d'		;modified to save 64 bits in LDT
	.define_pal rd_ps, 145
	.define_pal wr_ps_sw 156
	.define_pal getps, 145
	.if	df,evxrei
	.define_pal rei, 146
	.endc
	.if	df,evxr64d
	.define_pal rei, 146
	.endc
	.if	df,pcb$m_nounshelve
; If we allow the PCB flags used to control HSM to control this instead
; condition on pcbmsk$$ defined.
pcbmsk$$=0
	.endc
;b$fmt$=0	;disable "leave io$_format alone" mode
; Copyright 1993,1994,1995,1996,1997 Glenn C. Everhart
; All rights reserved
;  Author: Glenn C. Everhart
;
; mods:
; 30/jun/1994 GCE - Change kernel mapping logic to use a bitmap instead
; so we can basically map everything (to within an ambiguity factor).
; Use a 2KB buffer bitmap, which covers 16000 file numbers and will do
; a pretty good job of rejecting the rest. Then we can turn on the logic
; to only look at mapped files and save taking a performance hit on
; anything else (to all intents & purposes). For the moment just make the
; bitmap space a 2048 byte block constant in size for simplicity. In a
; later version we may make it vary in size. Use of this will allow us
; to protect ANY number of files even if the ACE gets deleted on them
; all...
; 7/7/94 gce - Deallocate LDT only AFTER the dowait call...
; 7/8/94 gce -step2 conversion begun
;
;
real_pvt=0	;define to include code that on bit 2048 prevents opens on
		;assigned devices, privs or not.
.ntype	__,R31			;  set EVAX nonzero if R31 is a register
.if eq <__ & ^xF0> - ^x50
EVAX = 1
.iff
;EVAX = 0
.endc
	.if	df,evax
evax = 1
alpha=1
bigpage=1
addressbits=32
;					;... EVAX=1 -> Step1
.iif ndf WCB$W_NMAP, evax=2		;... EVAX=2 -> Step2 (ndf as of T2.0)
.iif ndf WCB$W_NMAP, step2=1		;... EVAX=2 -> Step2 (ndf as of T2.0)
	.endc
;x$$$dt=0
	.if	ndf,evax
	.macro .jsb_entry
; jsb entry
	.endm
        .macro  driver_data
        .PSECT  $$$105_PROLOGUE
        .endm
        .macro driver_code
        .PSECT  $$$115_DRIVER
        .endm
	.endc
; above for Alpha only.
;
; function: "Tricks" driver.
;	Implements FDT capture (based on code published on sigtapes and
;	info-vax for "standard" capture techniques) and implements file
;	marking and transparent daemon access on open and various other
;	times. Also throws in fragmentation avoider.
;
; the driver works by intercepting FDT entries of a host driver and
; adding its own ahead of them. The most complex intercept is the
; open one (accfilt and on). It decides the i/o is of interest and
; issues its own $qio to read the file ACL to look for our ACE (application
; ACE, flagged by my initials). If this is found or the file is in an
; internal "look at" list then some actions happen immediately:
; setting privs/identifiers/base priority/softlinks. If the "send to
; daemon" flag is set in the ace (1 bit of flags) the open daemon
; (jtdmn) is sent a message and we wait on EF 31 till the daemon sends
; a special knl ast back. Note our qio thread produces a normal
; kernel AST and that does a special kernel AST from which the
; daemon call may be done. Once back, we reissue the FDT calls lower
; on kernel stack. On completing this we flag the mainline may go on
; set efn 31 and our "waitfor" cell, and go on. Once the mainline resumes
; it can delete the LDT (local area stuff) if appropriate or shorten
; it and free most of the memory grabbed during open. The open daemon
; can signal to either cause the i/o to fail or to make it seem to
; succeed without actually doing the open by appropriate return codes.
;
; delete and extend daemons are basically similar (as a directory daemon
; would be) but since they work on all files they omit the kernel thread
; that does its own I/O.
;
; For softlinks, in addition to moving file opens there 'n'
; back, keep a device table to let us refer to devices by using some
; hi bits in file ID & RVN areas to refer to rel. vol of a softlink-set
; by editing dir files on the way by when opened to have these bogus
; file IDs. On create,  must check DID field & see if we have an LDT
; with a flag for that dir, so we'd again clobber create (& user chnl) to
; point at the other disk during time the file's open. That may let us
; produce the illusion that softlinked dirs really "are" on the current
; volume.
;
; We will support file moving, delete management, dynamic priority,
; privs & identifiers, daemon-based additional access controls, 
; (which might be file integrity tests & conditional softlinks),
; and space management eventually. Also we'll eventually support
; special action on directore read-in so the dirs' files get arbitrated
; by a daemon instead of directly read. That'll let them be treated as
; softlinks too without having to clutter the disk, (ever maybe)
; with junk file headers.
; (juicer has dir layout docs in its comments.)
;
; Initial version basically to support security & limited hsm stuff,
; not ALL softlink possibilities.
;
; For a follow-on, we will add support for removing file headers completely.
; Note that we can do a softlink to other files so long as we can tell
; that the file should be so linked. Having a bitmap to let us filter
; out uninteresting files, our open daemon can tell that. To handle requests
; other than open we need to catch access without io$m_access, io$_acpcontrol,
; and some other functions of io$_modify and maybe io$_delete (depends on
; policy decision...SHOULD a file "somewhere else" be deleted apart from
; its "home" location...I think not, so just fake success for that). Where
; these don't open a file, we do the softlink by resetting the IRP only,
; not the channel too. Thus no catching logic is needed to put the user
; channel back.
;  By catching I/O in this way we can read in a linked directory from
; "somewhere" and just tag those file IDs as being in our bitmap, and
; record for the daemon that those files are on device xxx:, then let
; the daemon return the correct device softlink info to let the file
; be accessed at its home. The directory would reside on the local
; disk. When a file got created in it, the directory would get a real
; entry. An inswap would need the "somewhere" entry to be removed and
; a real one added and the daemon's data telling it where the real file
; was reset. At each directory open for such a directory that was "really"
; somewhere else, though, a merge of the then-current remote directory
; and the local one would be needed, concurrently updating the daemon's
; database, so new files created on the other device would appear in
; the local file, but files really on the local disk would appear. There
; could be problems where the directory read was from the XQP with
; this, though, so we may want to just pull the directory in every time
; regardless. We get control ahead of the XQP, but must ensure all
; processing of this kind is in another process, as the XQP is not in
; an interruptable point for this stuff.
;
;  It is possible to have directory entries pointing at nonexistent
; file headers and file IDs and have the access daemon (that handles
; io$_access, io$_acpcontrol etc.) generate a softlink to some real
; file on the fly. If the nonexistent directory entries are flagged by,
; say, bit 8 of the RVN being set, it might be possible to reset the
; access to the desired one in kernel mode. If done by a daemon using
; some other flagging (a bitmap maybe? Or maybe use RVN 255?) then
; the daemon is responsible for setting the correct FID and device into
; the request and device can be stored in the daemon database. Thus
; an outswapped file could be completely offline, yet the directory
; entry could be "there", and in moments of not inswapping it might be
; left pointing at some scratch file header that would point at a zero
; length file, via dynamic softlink, so that directory entries and so
; on would succeed even though their info would be fairly useless.
; (It's possible to reset the EOF pointer of these to the right size
; and possibly reset the date before each access should we choose to
; do so; file would be zero size anyhow. If a daemon access is used,
; the extra overhead of resetting date every time and so on might not
; be too bad. It would mean that the outswapped file size and at least
; creation date would still be visible even if the file ID was actually
; useless.)
; A second release would be usefully able to perform these operations
; so that outswapped file headers could be purged away, yet directory
; operations would continue to be able to show the files. This would mean
; that the directory files would continue to be large, but the index
; file would not grow boundlessly. If such a directory were outswapped,
; it might be inswapped later,being able to outswap only if it had no
; current files. This is a little easier than softlinking directories
; since no merging is needed. Directory opens are usually done by
; RMS in exec mode, and this would make it easy to shove an outswapped
; directory back in, from our daemon, doing so before the XQP actually
; gets the request queued to move anything. We'd need extra data in
; a daemon database and possibly in a knl mode bitmap to flag what
; was a directory; an outswapped directory might need to be flagged
; with an otherwise illegal FID so we would have a sure and certain
; tag to use on it. Inswapping it would then have to replace the
; FID in the parent directory. The directory file format seems not to
; have any checksums, so this will be comparatively clean and simple.
; Flagging in this way would allow clear detection of directory files,
; though the daemon would need to back up the test with its own data
; so inadvertent bogus matches would just be allowed to continue. (One
; might coopt RVN 255 and RVN 254 for directories and files respectively
; where one wanted a simple tag that could be used to recognize swapped
; dirs and files.) This way one could get rid of file headers off a disk,
; and periodically trim off directory files, yet the directories would
; still apparently be there if anyone looked (and if a mode to open
; them were selected; if not, the directory file could just be pointed
; at some ordinary file and the open would NOT show another directory).
;   Normally you'd want to limit depth of opening old outswapped directories
; by telling the daemon how old a directory might be and still be opened
; (so a simple dir [...]*.* doesn't inswap everything unless that's really
; wanted). Since you'd be regulating at the granularity of directories
; filetype cuts might not show up, but directories would. Users could 
; reset directory creation dates with the FILE utility or similar if
; they wanted to keep these dates useful. A script to reset directory
; revision dates to the date of last file creation should be supplied
; to be run periodically, so that this information would be more
; useful; VMS normally doesn't maintain it.
;
; Glenn C. Everhart, November 1993
;
;vms$$v6=0	;add forvms v6 def'n
vms$v5=1
; define v5$picky also for SMP operation
v5$picky=1
	.SBTTL	EXTERNAL AND LOCAL DEFINITIONS

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

;	$ADPDEF				;DEFINE ADAPTER CONTROL BLOCK
	$CRBDEF				;DEFINE CHANNEL REQUEST BLOCK
	$DYNDEF ;define dynamic data types
	$DCDEF				;DEFINE DEVICE CLASS
	$DDBDEF				;DEFINE DEVICE DATA BLOCK
	$DEVDEF				;DEFINE DEVICE CHARACTERISTICS
	$DPTDEF				;DEFINE DRIVER PROLOGUE TABLE
	$EMBDEF				;DEFINE ERROR MESSAGE BUFFER
	$IDBDEF				;DEFINE INTERRUPT DATA BLOCK
	$IODEF				;DEFINE I/O FUNCTION CODES
	$DDTDEF				; DEFINE DISPATCH TBL...
	.if df,step2
	ddt$l_fdt=ddt$ps_fdt_2
	.endc
	$ptedef
	$vadef
	$IRPDEF				;DEFINE I/O REQUEST PACKET
	$irpedef
	$PRDEF				;DEFINE PROCESSOR REGISTERS
	$SSDEF				;DEFINE SYSTEM STATUS CODES
	$UCBDEF				;DEFINE UNIT CONTROL BLOCK
	.if	df,step2
	$fdt_contextdef
	$fdtargdef
	$fdtdef
	.endc
	$sbdef	; system blk offsets
	$psldef
	$prdef
	$acldef
	$rsndef				;define resource numbers
	$acedef
	$VECDEF				;DEFINE INTERRUPT VECTOR BLOCK
	$pcbdef
	.if	df,pcb$m_nounshelve
; If we allow the PCB flags used to control HSM to control this instead
; condition on pcbmsk$$ defined.
pcbmsk$$=0
	.endc
        .iif ndf, PCB$M_NOUNSHELVE, PCB$M_NOUNSHELVE=^x80000
        .iif ndf, PCB$M_SHELVING_RESERVED,PCB$M_SHELVING_RESERVED=^x100000
        .iif ndf, PCB$V_NOUNSHELVE,PCB$V_NOUNSHELVE=19
        .iif ndf, PCB$V_SHELVING_RESERVED,PCB$V_SHELVING_RESERVED=20
	$statedef
	$jibdef
	$acbdef
	$vcbdef
	$arbdef
	$wcbdef
	$ccbdef
	$fcbdef
	$phddef
        $RABDEF                         ; RAB structure defs
        $RMSDEF                         ; RMS constants
; defs for acl hacking
	$fibdef
	$ipldef
	$atrdef
	.if	df,pcb$ar_natural_psb_def
; Allow mods of PSB based privs etc. if it exists.
	$ktbdef
	$psbdef
	.endc
p1=0	; first qio param
p2=4
p3=8
p4=12
p5=16
p6=20	;6th qio param offsets

	.IF	DF,VMS$V5	;VMS V5 + LATER ONLY
	$SPLCODDEF
	$cpudef
	.ENDC
; 
; UCB OFFSETS WHICH FOLLOW THE STANDARD UCB FIELDS
; 
	$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$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=^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
$def	ucb$a_dirbmp	.blkl	128	; directory bitmap
didnum=512 * 8	; number of DIDs we consider for purposes of handling w/o
		; directory handling support. 1 in a bit means this DID may 
		; need w/o treatment
	.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
; 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)
				;(we'll use high bits for some added flags)
ldt$v_opnchk = 31	; open check bit. If set always check opens from
			; this process while this file is open. We pass it
			; here since this long is passed to jtdmn.
ldt$m_opnchk = ^x80000000
ldt$v_runfcn = 30	; if set, jtdmn may run some function at open.
ldt$m_runfcn = ^x40000000
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	=	432		;slop storage for flags
ldt$l_parm	=	436		;storage for up to 6 params (6 longs)
ldt$l_fib	=	456		;FIB we use for OUR I/O
; 72 bytes max for our FIB
ldt$l_acl	=	532		;storage for ACL read-in; 512 bytes
ldt$l_itmlst	=	1044		;item list to read the ACL all in if
					;we can.
ldt$l_aclsiz	=	1076		;size of the ACL on the file
ldt$l_rtnsts	=	1080		;status back from daemon
ldt$l_myfid	=	1088		;file id from read-acl call
ldt$l_mydid	=	1096		;dir id in user's fib
ldt$l_psl	=	1104		;psl of original i/o
ldt$l_fnd	=	1112		;filename desc of orig i/o (p2 arg)
					;2 longs
ldt$l_fndd	=	1120		;data area for filename (256 bytes)
ldt$l_fdtctx	=	1380		;save area for user's FDT context ptr
ldt$l_size	=       1392
ldt$k_clrsiz	=	1388		;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
; 07 - "temporary" tag. Format:
;	07, len, <orig file id>, <sys time quadword when created> ;16 bytes
; 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.

 
	.SBTTL	STANDARD TABLES

; 
; DRIVER PROLOGUE TABLE
; 
; 	THE DPT DESCRIBES DRIVER PARAMETERS AND I/O DATABASE FIELDS
; 	THAT ARE TO BE INITIALIZED DURING DRIVER LOADING AND RELOADING
; 
	driver_data
JT_UNITS=300
JT$DPT::
.iif ndf,spt$m_xpamod,dpt$m_xpamod=0
	.if	df,evax
	DPTAB	-			;DPT CREATION MACRO
		END=JT_END,-		;END OF DRIVER LABEL
		ADAPTER=NULL,-		;ADAPTER TYPE = NONE (VIRTUAL)
		FLAGS=DPT$M_SMPMOD!dpt$m_xpamod!DPT$M_NOUNLOAD, - ;SET TO USE SMP,xa
		DEFUNITS=2,-		;UNITS 0 THRU 1 thru 31
		step=2,-
		UCBSIZE=UCB$K_JT_LEN,-	;LENGTH OF UCB
		MAXUNITS=JT_UNITS,-	;FOR SANITY...CAN CHANGE
		NAME=JTDRIVER		;DRIVER NAME
	.iff
	.if ndf,vms$$v6
	DPTAB	-			;DPT CREATION MACRO
		END=JT_END,-		;END OF DRIVER LABEL
		ADAPTER=NULL,-		;ADAPTER TYPE = NONE (VIRTUAL)
		FLAGS=DPT$M_SMPMOD!DPT$M_NOUNLOAD, -	;SET TO USE SMP
		DEFUNITS=2,-		;UNITS 0 THRU 1 thru 31
		UCBSIZE=UCB$K_JT_LEN,-	;LENGTH OF UCB
		MAXUNITS=JT_UNITS,-	;FOR SANITY...CAN CHANGE
		NAME=JTDRIVER		;DRIVER NAME
	.iff
	DPTAB	-			;DPT CREATION MACRO
		END=JT_END,-		;END OF DRIVER LABEL
		ADAPTER=NULL,-		;ADAPTER TYPE = NONE (VIRTUAL)
		FLAGS=DPT$M_SMPMOD!dpt$m_xpamod!DPT$M_NOUNLOAD, - ;SET TO USE SMP,xa
		DEFUNITS=2,-		;UNITS 0 THRU 1 thru 31
		UCBSIZE=UCB$K_JT_LEN,-	;LENGTH OF UCB
		MAXUNITS=JT_UNITS,-	;FOR SANITY...CAN CHANGE
		NAME=JTDRIVER		;DRIVER NAME
	.endc
	.endc
	DPT_STORE INIT			;START CONTROL BLOCK INIT VALUES
	DPT_STORE DDB,DDB$L_ACPD,L,<^A\F11\>  ;DEFAULT ACP NAME
	DPT_STORE DDB,DDB$L_ACPD+3,B,DDB$K_PACK	;ACP CLASS
	.IF	NDF,VMS$V5
	DPT_STORE UCB,UCB$B_FIPL,B,8	;FORK IPL (VMS V4.X)
	.IFF	;DEFINE FOR VMS V5.X & LATER
	DPT_STORE UCB,UCB$B_FLCK,B,SPL$C_IOLOCK8  ;FORK IPL (VMS V5.X + LATER)
	.ENDC
; These characteristics for an intercept driver shouldn't look just
; like a real disk unless it is prepared to handle being mounted, etc.
; Therefore comment a couple of them out.
	DPT_STORE UCB,UCB$L_DEVCHAR,L,-	;DEVICE CHARACTERISTICS
		<DEV$M_SHR-		; SHAREABLE
;		!DEV$M_DIR-		; DIRECTORY STRUCTURED
		!DEV$M_AVL-		; AVAILABLE
;		!DEV$M_FOD-		; FILES ORIENTED
		!DEV$M_IDV-		; INPUT DEVICE
		!DEV$M_ODV-		; OUTPUT DEVICE
		!DEV$M_RND>		; RANDOM ACCESS
	DPT_STORE UCB,UCB$L_DEVCHAR2,L,- ;DEVICE CHARACTERISTICS
		<DEV$M_NNM>		; Prefix name with "node$" (like rp06)
	DPT_STORE UCB,UCB$B_DEVCLASS,B,DC$_MISC  ;DEVICE CLASS
	DPT_STORE UCB,UCB$W_DEVBUFSIZ,W,512  ;DEFAULT BUFFER SIZE
; FOLLOWING DEFINES OUR DEVICE "PHYSICAL LAYOUT". It's faked here.
	DPT_STORE UCB,UCB$B_TRACKS,B,1	; 1 TRK/CYL
	DPT_STORE UCB,UCB$B_SECTORS,B,64  ;NUMBER OF SECTORS PER TRACK
	DPT_STORE UCB,UCB$W_CYLINDERS,W,16  ;NUMBER OF CYLINDERS
	DPT_STORE UCB,UCB$B_DIPL,B,8	;DEVICE IPL
;	DPT_STORE UCB,UCB$B_ERTMAX,B,10	;MAX ERROR RETRY COUNT
	DPT_STORE UCB,UCB$L_DEVSTS,L,-	;INHIBIT LOG TO PHYS CONVERSION IN FDT
		<UCB$M_NOCNVRT>		;...
;
; don't mess with LBN; leave alone so it's easier to hack on...
;
	DPT_STORE REINIT		;START CONTROL BLOCK RE-INIT VALUES
;	DPT_STORE CRB,CRB$L_INTD+VEC$L_ISR,D,JT_INT  ;INTERRUPT SERVICE ROUTINE ADDRESS
	.if	ndf,evax
	DPT_STORE CRB,CRB$L_INTD+VEC$L_INITIAL,-  ;CONTROLLER INIT ADDRESS
		      D,JT_ctrl_INIT		  ;...
	DPT_STORE CRB,CRB$L_INTD+VEC$L_UNITINIT,- ;UNIT INIT ADDRESS
		      D,JT_unit_INIT		  ;...
	.endc
	DPT_STORE DDB,DDB$L_DDT,D,JT$DDT	  ;DDT ADDRESS
        DPT_STORE UCB,UCB$L_UNIQID,D,driver$dpt    ;store DPT address
;        DPT_STORE UCB,UCB$L_UNIQID,D,DPT$TAB    ;store DPT address
                                                ; (change "XX" to device
                                                ; mnemonic correct values)
        DPT_STORE UCB,UCB$L_ICSIGN,L,magic      ; Add unique pattern (that might
                                                ; bring back some memories in
                                                ; DOS-11 users)

; HISTORICAL NOTE: under DOS-11, one would get F012 and F024 errors
; on odd address and illegal instruction traps. If we don't have
; this magic number HERE, on the other hand, we're likely to see
; bugchecks in VMS due to uncontrolled bashing of UCB fields!
	DPT_STORE END			;END OF INITIALIZATION TABLE

; 
; DRIVER DISPATCH TABLE
; 
; 	THE DDT LISTS ENTRY POINTS FOR DRIVER SUBROUTINES WHICH ARE
; 	CALLED BY THE OPERATING SYSTEM.
; 
;JT$DDT:
	.if	df,evax
        .if     df,irp$q_qio_p1
	DDTAB	-			;DDT CREATION MACRO
		DEVNAM=JT,-		;NAME OF DEVICE
		START=JT_STARTIO,-	;START I/O ROUTINE
		FUNCTB=JT_FUNCTABLE,-	;FUNCTION DECISION TABLE
		CTRLINIT=JT_CTRL_INIT,-
		UNITINIT=JT_UNIT_INIT,-
		CANCEL=0,-		;CANCEL=NO-OP FOR FILES DEVICE
		REGDMP=0,-	;REGISTER DUMP ROUTINE
		DIAGBF=0,-  ;BYTES IN DIAG BUFFER
		ERLGBF=0	;BYTES IN
				;ERRLOG BUFFER
	.iff
	DDTAB	-			;DDT CREATION MACRO
		DEVNAM=JT,-		;NAME OF DEVICE
		START=JT_STARTIO,-	;START I/O ROUTINE
		FUNCTB=JT_FUNCTABLE,-	;FUNCTION DECISION TABLE
		CTRLINIT=JT_CTRL_INIT,-
		UNITINIT=JT_UNIT_INIT,-
		CANCEL=0,-		;CANCEL=NO-OP FOR FILES DEVICE
		REGDMP=0,-	;REGISTER DUMP ROUTINE
		DIAGBF=0,-  ;BYTES IN DIAG BUFFER
		ERLGBF=0,-	;BYTES IN ERRLOG BUFFER
                FAST_FDT=ACP_STD$FASTIO_BLOCK   ; Fast-IO FAST_FDT
	.endc ;64bit
	.iff
	DDTAB	-			;DDT CREATION MACRO
		DEVNAM=JT,-		;NAME OF DEVICE
		START=JT_STARTIO,-	;START I/O ROUTINE
		FUNCTB=JT_FUNCTABLE,-	;FUNCTION DECISION TABLE
;		CANCEL=0,-		;CANCEL=NO-OP FOR FILES DEVICE
;		REGDMP=0,-	;REGISTER DUMP ROUTINE
;		DIAGBF=0,-  ;BYTES IN DIAG BUFFER
		ERLGBF=0	;BYTES IN
				;ERRLOG BUFFER
	.endc
; 
; FUNCTION DECISION TABLE
; 
; 	THE FDT LISTS VALID FUNCTION CODES, SPECIFIES WHICH
; 	CODES ARE BUFFERED, AND DESIGNATES SUBROUTINES TO
; 	PERFORM PREPROCESSING FOR PARTICULAR FUNCTIONS.
; 
; note the stuff here needs to be an octaword multiple.
v15a:	.address	vcstp15		;AST address for internal AST
kasta:	.address	jtkast		;SKAST addr for daemon to use
ACLlit:	.ascii	/GCEV/		;literal for our use for ACE flag
	.long	0	;pad to mult. of 8
; code chaining data:
chnflg:	.long	0	;chain or use our FDT chain flag...use ours if 0
myonoff:
fdtonoff: .long 0	;switch my fdt stuff off if non-0
	.ascii	/flag/	;define your own unique flag here; just leave it 4 bytes long!
	.long 0		;fdt tbl from before patch
fdt_chn  = -12
fdt_prev = -4
fdt_idnt = -8
	.if	ndf,evax
JT_FUNCTABLE:
	FUNCTAB	,-			;LIST LEGAL FUNCTIONS
		<NOP,-			; NO-OP
		FORMAT,-		; We use format to point to file
		UNLOAD,-		; UNLOAD
		PACKACK,-		; PACK ACKNOWLEDGE
		AVAILABLE,-		; AVAILABLE
		SENSECHAR,-		; SENSE CHARACTERISTICS
		SETCHAR,-		; SET CHARACTERISTICS
		SENSEMODE,-		; SENSE MODE
		SETMODE,-		; SET MODE
		READLBLK,-		; READ LOGICAL BLOCK
		WRITELBLK,-		; WRITE LOGICAL BLOCK
;		READPBLK,-		; READ PHYSICAL BLOCK 
;		WRITEPBLK,-		; WRITE PHYSICAL BLOCK
		READVBLK,-		; READ VIRTUAL BLOCK
		WRITEVBLK,-		; WRITE VIRTUAL BLOCK
		ACCESS,-		; ACCESS FILE / FIND DIRECTORY ENTRY
		ACPCONTROL,-		; ACP CONTROL FUNCTION
		CREATE,-		; CREATE FILE AND/OR DIRECTORY ENTRY
		DEACCESS,-		; DEACCESS FILE
		DELETE,-		; DELETE FILE AND/OR DIRECTORY ENTRY
		MODIFY,-		; MODIFY FILE ATTRIBUTES
		MOUNT>			; MOUNT VOLUME
; no-op phys I/O for a test here...
	FUNCTAB	,-			;BUFFERED FUNCTIONS
		<NOP,-
		FORMAT,-		; FORMAT
		UNLOAD,-		; UNLOAD
		PACKACK,-		; PACK ACKNOWLEDGE
		AVAILABLE,-		; AVAILABLE
		SENSECHAR,-		; SENSE CHARACTERISTICS
		SETCHAR,-		; SET CHARACTERISTICS
		SENSEMODE,-		; SENSE MODE
		SETMODE,-		; SET MODE
		ACCESS,-		; ACCESS FILE / FIND DIRECTORY ENTRY
		ACPCONTROL,-		; ACP CONTROL FUNCTION
		CREATE,-		; CREATE FILE AND/OR DIRECTORY ENTRY
		DEACCESS,-		; DEACCESS FILE
		DELETE,-		; DELETE FILE AND/OR DIRECTORY ENTRY
		MODIFY,-		; MODIFY FILE ATTRIBUTES
		MOUNT>			; MOUNT VOLUME
myfdtstart:
	FUNCTAB	JT_ALIGN,-		;TEST ALIGNMENT FUNCTIONS
		<READLBLK,-		; READ LOGICAL BLOCK
		READVBLK,-		; READ VIRTUAL BLOCK
		READPBLK,-
;		WRITEPBLK,-
		WRITELBLK,-		; WRITE LOGICAL BLOCK
		WRITEVBLK-		; WRITE VIRTUAL BLOCK
		>
; io$_format + modifiers (e.g. io$_format+128) as function code
; allows one to associate a JT unit and some other device; see
; the JT_format code comments for description of buffer to be passed.
	functab JT_format,-		;point to host disk
		<format>
;
; First our very own filter routines
;
; Following FDT function should cover every function in the local
; FDT entries between "myfdtbgn" and "myfdtend", in this case just
; mount and modify. Its function is to switch these off or on at
; need.
	Functab fdtswitch,-
		<mount,modify,create,deaccess,access,delete>
myfdtbgn=.
; Leave a couple of these in place as an illustration. You would of course
; need to insert your own if you're messing with FDT code, or remove these if
; you don't want to. The FDT switch logic is a waste of time and space if
; you do nothing with them...
; They don't actually do anything here, but could be added to. Throw in one
; to call some daemon at various points and it can act as a second ACP
; when control is inserted at FDT time (ahead of the DEC ACP/XQP code!)
	FUNCTAB	MFYMOUNT,-		;MOUNT FUNCTION
		<MOUNT>			; MOUNT VOLUME
	functab accfilt,-		;Access file (open files)
		<access>
	functab deacfilt,-		;deaccess file (close)
		<deaccess>
	functab	crefilt,-		;create file
		<create>
	FuncTab	DelFilt,-		;delete file
		<delete>
	FuncTab MFYFilt,-
		<MODIFY>		;modify filter (e.g. extend)
myfdtend=.
; Note that if we want to allow numerous disk drivers to be patched
; by this one there is not a unique path to the original fdt
; routine. Therefore use a UCB cell for the patch, not a cell
; ahead of the FDT. That way each unit gets a good return
; path. That's why there's an "oldfdt" cell in the UCB here.
;
;
; Following contains all legal functions in mask...
; That way it can transfer all control to a "previous" FDT chain.
fdtlclcnt:
	FuncTab fdttoorig,-
		<NOP,-			; NO-OP
		FORMAT,-		; We use format to point to file
		UNLOAD,-		; UNLOAD
		PACKACK,-		; PACK ACKNOWLEDGE
		AVAILABLE,-		; AVAILABLE
		SENSECHAR,-		; SENSE CHARACTERISTICS
		SETCHAR,-		; SET CHARACTERISTICS
		SENSEMODE,-		; SENSE MODE
		SETMODE,-		; SET MODE
		READLBLK,-		; READ LOGICAL BLOCK
		WRITELBLK,-		; WRITE LOGICAL BLOCK
		READPBLK,-		; READ PHYSICAL BLOCK 
		WRITEPBLK,-		; WRITE PHYSICAL BLOCK
		READVBLK,-		; READ VIRTUAL BLOCK
		WRITEVBLK,-		; WRITE VIRTUAL BLOCK
		ACCESS,-		; ACCESS FILE / FIND DIRECTORY ENTRY
		ACPCONTROL,-		; ACP CONTROL FUNCTION
		CREATE,-		; CREATE FILE AND/OR DIRECTORY ENTRY
		DEACCESS,-		; DEACCESS FILE
		DELETE,-		; DELETE FILE AND/OR DIRECTORY ENTRY
                CRESHAD,-                       ; Create a shadow set virtual u$
                DIAGNOSE,-                      ; Special pass-through function
                REMSHAD,-                       ; Remove a shadow set member
		DSE,-			;data security erase
                SETPRFPATH,-            ;  Set preferred path
                READRCT,-              ;  Read RCT block
                ADDSHAD,-              ;  Add a shadow set member
                SHADMV,-                ;  Invoke shadow set mount verification
                 SEEK,-                 ;SEEK CYLINDER
                 RECAL,-                ;RECALIBRATE
                 DRVCLR,-               ;DRIVE CLEAR
                 RELEASE,-              ;RELEASE PORT
                 OFFSET,-               ;OFFSET HEADS
                 RETCENTER,-            ;RETURN HEADS TO CENTERLINE
                 SEARCH,-               ;SEARCH FOR SECTOR
                 READPRESET,-           ;READ IN PRESET
                 WRITEHEAD,-            ;WRITE HEADER AND DATA
                 READHEAD,-             ;READ HEADER AND DATA
                 WRITECHECKH,-          ;WRITE CHECK HEADER AND DATA
                 STARTSPNDL,-           ;START SPINDLE
                WRITETRACKD,-           ;WRITE TRACK DESCRIPTOR
                READTRACKD,-            ;READ TRACK DESCRIPTOR
                COPYSHAD,-             ;  Do shadow set copies
		MODIFY,-		; MODIFY FILE ATTRIBUTES
		MOUNT>			; MOUNT VOLUME
; Now the "standard" disk FDT routines needed to let ODS-2 work (or ods-1 !)
; (Where we are doing read - or possibly write- virtual by hand ourselves
;  we may never get to these BTW...)
	FUNCTAB	+ACP$READBLK,-		;READ FUNCTIONS
		<READLBLK,-		; READ LOGICAL BLOCK
		READPBLK,-
		READVBLK-		; READ VIRTUAL BLOCK
		>
	FUNCTAB	+ACP$WRITEBLK,-		;WRITE FUNCTIONS
		<WRITELBLK,-		; WRITE LOGICAL BLOCK
		WRITEPBLK,-
		WRITEVBLK-		; WRITE VIRTUAL BLOCK
		>
	FUNCTAB	+ACP$ACCESS,-		;ACCESS FUNCTIONS
		<ACCESS,-		; ACCEESS FILE / FIND DIRECTORY ENTRY
		CREATE-			; CREATE FILE AND/OR DIRECTORY ENTRY
		>
	FUNCTAB	+ACP$DEACCESS,-		;DEACCESS FUNCTION
		<DEACCESS-		; DEACCESS FILE
		>
	FUNCTAB	+ACP$MODIFY,-		;MODIFY FUNCTIONS
		<ACPCONTROL,-		; ACP CONTROL FUNCTION
		DELETE,-		; DELETE FILE AND/OR DIRECTORY ENTRY
		MODIFY-			; MODIFY FILE ATTRIBUTES
		>
	FUNCTAB	+ACP$MOUNT,-		;MOUNT FUNCTION
		<MOUNT>			; MOUNT VOLUME
        FUNCTAB +EXE$LCLDSKVALID,-      ;LOCAL DISK VALID FUNCTIONS
                <UNLOAD,-               ;UNLOAD VOLUME
                 AVAILABLE,-            ;UNIT AVAILABLE
                 PACKACK>               ;PACK ACKNOWLEDGE
	FUNCTAB	+EXE$ZEROPARM,-		;ZERO PARAMETER FUNCTIONS
		<UNLOAD,-		; UNLOAD
		PACKACK,-		; PACK ACKNOWLEDGE
		AVAILABLE>		; AVAILABLE
	FUNCTAB	+EXE$ONEPARM,-		;ONE PARAMETER FUNCTION
		<FORMAT-		; FORMAT
		>
	FUNCTAB	+EXE$SENSEMODE,-	;SENSE FUNCTIONS
		<SENSECHAR,-		; SENSE CHARACTERISTICS
		SENSEMODE-		; SENSE MODE
		>
	FUNCTAB	+EXE$SETCHAR,-		;SET FUNCTIONS
		<SETCHAR,-		; SET CHARACTERISTICS
		SETMODE-		; SET MODE
		>
; This routine normally would be called to go back to our FDT chain at 
; fdtlclcnt; it lies after all normal ones would go. It transfers from the FDT
; table in the UCB to the JTdriver table. At fdtlclcnt we transfer to the 
; original driver fdt chain. Note this needs serious mods in axp step2...
mybak:
	FuncTab fdttoucb,-
		<NOP,-			; NO-OP
		FORMAT,-		; We use format to point to file
		UNLOAD,-		; UNLOAD
		PACKACK,-		; PACK ACKNOWLEDGE
		AVAILABLE,-		; AVAILABLE
		SENSECHAR,-		; SENSE CHARACTERISTICS
		SETCHAR,-		; SET CHARACTERISTICS
		SENSEMODE,-		; SENSE MODE
		SETMODE,-		; SET MODE
		READLBLK,-		; READ LOGICAL BLOCK
		WRITELBLK,-		; WRITE LOGICAL BLOCK
		READPBLK,-		; READ PHYSICAL BLOCK 
		WRITEPBLK,-		; WRITE PHYSICAL BLOCK
		READVBLK,-		; READ VIRTUAL BLOCK
		WRITEVBLK,-		; WRITE VIRTUAL BLOCK
		ACCESS,-		; ACCESS FILE / FIND DIRECTORY ENTRY
		ACPCONTROL,-		; ACP CONTROL FUNCTION
		CREATE,-		; CREATE FILE AND/OR DIRECTORY ENTRY
		DEACCESS,-		; DEACCESS FILE
		DELETE,-		; DELETE FILE AND/OR DIRECTORY ENTRY
                CRESHAD,-                       ; Create a shadow set virtual u$
                DIAGNOSE,-                      ; Special pass-through function
                REMSHAD,-                       ; Remove a shadow set member
		DSE,-			;data security erase
                SETPRFPATH,-            ;  Set preferred path
                READRCT,-              ;  Read RCT block
                ADDSHAD,-              ;  Add a shadow set member
                SHADMV,-                ;  Invoke shadow set mount verification
                 SEEK,-                 ;SEEK CYLINDER
                 RECAL,-                ;RECALIBRATE
                 DRVCLR,-               ;DRIVE CLEAR
                 RELEASE,-              ;RELEASE PORT
                 OFFSET,-               ;OFFSET HEADS
                 RETCENTER,-            ;RETURN HEADS TO CENTERLINE
                 SEARCH,-               ;SEARCH FOR SECTOR
                 READPRESET,-           ;READ IN PRESET
                 WRITEHEAD,-            ;WRITE HEADER AND DATA
                 READHEAD,-             ;READ HEADER AND DATA
                 WRITECHECKH,-          ;WRITE CHECK HEADER AND DATA
                 STARTSPNDL,-           ;START SPINDLE
                WRITETRACKD,-           ;WRITE TRACK DESCRIPTOR
                READTRACKD,-            ;READ TRACK DESCRIPTOR
                COPYSHAD,-             ;  Do shadow set copies
		MODIFY,-		; MODIFY FILE ATTRIBUTES
		MOUNT>			; MOUNT VOLUME
	.iff
JT_FUNCTABLE:
	FDT_INI
	FDT_BUF -	; BUFFERED functions
		<NOP,-
		UNLOAD,-		; UNLOAD
		FORMAT,-		; FORMAT
		PACKACK,-		; PACK ACKNOWLEDGE
		AVAILABLE,-		; AVAILABLE
		SENSECHAR,-		; SENSE CHARACTERISTICS
		SETCHAR,-		; SET CHARACTERISTICS
		SENSEMODE,-		; SENSE MODE
		SETMODE,-		; SET MODE
		ACCESS,-		; ACCESS FILE / FIND DIRECTORY ENTRY
		ACPCONTROL,-		; ACP CONTROL FUNCTION
		CREATE,-		; CREATE FILE AND/OR DIRECTORY ENTRY
		DEACCESS,-		; DEACCESS FILE
		DELETE,-		; DELETE FILE AND/OR DIRECTORY ENTRY
		MODIFY,-		; MODIFY FILE ATTRIBUTES
		MOUNT>			; MOUNT VOLUME
        .if     df,irp$q_qio_p1
; Note that as an intercept driver we copy the target FDT and actually d
; need this, but do it for beauty.
        FDT_64  <-                              ; Functions supporting 66bt addresses
                AVAILABLE,-                     ; Available (rewind/nowavalid)
                NOP,-                           ; No operation
                PACKACK,-                       ; Pack acknowledge
                READLBLK,-                      ; Read logical block for
                READPBLK,-                      ; Read physical block fo
                READVBLK,-                      ; Read virtual block
                SENSECHAR,-                     ; Sense characteristics
                SENSEMODE,-                     ; Sense mode
                SETCHAR,-                       ; Set characterisitics
                SETMODE,-                       ; Set mode
                UNLOAD,-                        ; Unload volume
                WRITECHECK,-                    ; Write check
                WRITELBLK,-                     ; Write LOGICAL Block
                WRITEPBLK,-                     ; Write Physical Block
                WRITEVBLK>                      ; Write VIRTUAL Block
        .endc
myfdtstart:
; io$_format + modifiers (e.g. io$_format+128) as function code
; allows one to associate a JT unit and some other device; see
; the JT_format code comments for description of buffer to be passed.
	fdt_act JT_format,-		;point to host disk
		<format>
;
; First our very own filter routines
;
; Following FDT function should cover every function in the local
; FDT entries between "myfdtbgn" and "myfdtend", in this case just
; mount and modify. Its function is to switch these off or on at
; need.
myfdtbgn=.
; Leave a couple of these in place as an illustration. You would of course
; need to insert your own if you're messing with FDT code, or remove these if
; you don't want to. The FDT switch logic is a waste of time and space if
; you do nothing with them...
; They don't actually do anything here, but could be added to. Throw in one
; to call some daemon at various points and it can act as a second ACP
; when control is inserted at FDT time (ahead of the DEC ACP/XQP code!)
	fdt_act	MFYMOUNT,-		;MOUNT FUNCTION
		<MOUNT>			; MOUNT VOLUME
	fdt_act accfilt,-		;Access file (open files)
		<access>
	fdt_act deacfilt,-		;deaccess file (close)
		<deaccess>
	fdt_act	crefilt,-		;create file
		<create>
	fdt_act	DelFilt,-		;delete file
		<delete>
	fdt_act MFYFilt,-
		<MODIFY>		;modify filter (e.g. extend)
	.if	df,lp$filt
; The logical I/O filter is optional but is intended to allow one to
; test that the device is non-foreign mounted and if mounted and NOT foreign
; it will reject logical or physical r/w from user mode channels. This is
; designed to help protect against apps like ods2-reader that bypass the
; file system, privs or no.
	FDT_Act	RWFilt,-		;read/write logical filter
		<READLBLK,-		; READ LOGICAL BLOCK
		READPBLK,-
		WRITELBLK,-		; WRITE LOGICAL BLOCK
		WRITEPBLK-
		>
	.endc
myfdtend=.
	.endc
; Data used for templates and so on here
; item list for reading ACL
gceacl:	.word	512			;ACL buffer is 512 bytes long
	.word	atr$c_readacl		;read the whole ACL in if we can
gceaba:	.long	0			;address of ACL buffer in LDT
	.word	4			;get ACL length
	.word	atr$c_acllength		; this item reads ACL length
gceala:	.long	0			; address in LDT of cell to get ACL size
	.long	0,0			;terminator for item list
gcetpl=.-gceacl				;length of template.
; Flag literal used to check for MY ACL entries.
gceflg:	.ascii	/GCEV/			;use my initials...
jt_ucb:
jt_utb:
	.rept	jt_units
	.long	0
	.endr
	.long	0,0,0,0,0,0,0,0,0,0

	driver_code
	.if	ndf,evax
; fdtswitch -
;   Based on state of "myonoff" variable either enable or disable
; my FDT processing, allowing the FDT chain to remain always intact.
; This needs to be the first of a chain of FDT entries added to the
; FDT processing of a driver.

fdtswitch: .jsb_entry
	tstl	fdtonoff		;global on/off
	bneq	1$
	rsb				;go to next FDT if null
1$:	addl2	#<myfdtend-myfdtbgn>,r8	;pass our fdt codes
	rsb				;return to std
; fdttoorig -
;  This entry continues FDT processing at the point after the new
; entries by returning to the original FDT chain at the point where
; that chain begins. (It is presumed that FDT entries will always be
; added ahead of existing ones due to the nonreturning nature of
; FDT processing.) This is done instead of simply duplicating the
; DEC FDT entries because in this way multiple FDT patches can
; coexist, as would be impossible if this trick were not used. As
; can be seen, its overhead is minimal.
;  The old FDT location is kept in the UCB for our device because
; that allows us to get back to different FDTs when several drivers'
; FDT chains are pointed here first.
fdttoorig: .jsb_entry
	pushl	r0
; (this routine gets called a fair bit and if GETJTUCB can be
;  called less, things speed up.)
	jsb	getjtucb		;get UCB for JT unit from stolen
					;one
	tstl	r0			;r0 is return UCB
	bgeq	1$			;if not negative, not a UCB
	tstl	ucb$l_oldfdt(r0)	;a prior fdt exist?
	beql	1$
        movl    ucb$l_oldfdt(r0),r8      ;point to original FDT point
        addl2   #<16-12>,r8      ;pass the 2 entry masks
1$:                                 ;back up since sysqioreq adds 12
	popl	r0
2$:        rsb                      ;off to the previous FDT routines.
; fdttoucb -
;  This entry continues FDT processing at the point after the new
; entries by returning to the original FDT chain at the point where
; that chain begins. (It is presumed that FDT entries will always be
; added ahead of existing ones due to the nonreturning nature of
; FDT processing.) This is done instead of simply duplicating the
; DEC FDT entries because in this way multiple FDT patches can
; coexist, as would be impossible if this trick were not used. As
; can be seen, its overhead is minimal.
;  The old FDT location is kept in the UCB for our device because
; that allows us to get back to different FDTs when several drivers'
; FDT chains are pointed here first.
	.if	df,evax
fdttoucb: .jsb_entry output=<r8>
	.iff
fdttoucb:
	.endc
	pushl	r0
; (this routine gets called a fair bit and if GETJFUCB can be
;  called less, things speed up.)
	movab	myfdtstart,r8
	subl2	#12,r8			;start at our FDT entries
; note sysqioreq adds 12 so we start 12 bytes earlier.
1$:                                 ;back up since sysqioreq adds 12
	popl	r0
2$:        rsb                      ;off to the previous FDT routines.
	.endc
;
; GETJTUCB - Find JT: UCB address, given r5 points to UCB of the patched
; device. Return the UCB in R0, which should return 0 if we can't find
; it.
;   This routine is called a lot and therefore is made as quick as
; it well can be, especially for the usual case.
getjtucb: .jsb_entry output=<r0>
;	clrl	r0	;no UCB initially found
	pushl	r10
	pushl	r11	;faster than pushr supposedly
;	pushr	#^m<r10,r11>
; Assumes that R5 is the UCB address of the device that has had some
; code intercepted and that we are in some bit of code that knows
; it is in an intercept driver. Also assumes R11 may be used as
; scratch registers (as is true in FDT routines). Control returns at
; label "err" if the DDT appears to have been clobbered by
; something not following this standard, if conditional "chk.err"
; is defined.
;       Entry: R5 - victim device UCB address
;       Exit: R11 - intercept driver UCB address
chk.err=0
        movl    ucb$l_ddt(r5),r10       ;get the DDT we currently have
; note we know our virtual driver's DPT address!!!
        movab   driver$dpt,r11              ;magic pattern is DPT addr.
; lock this section with forklock so we can safely remove
; entries at fork also. Use victim device forklock.
; (don't preserve r0 since we clobber it anyway.)
        forklock lock=ucb$b_flck(r5),savipl=-(sp),preserve=NO
2$:     cmpl    <ucb$l_uniqid-ucb$a_vicddt>(r10),R11
                                        ;this our own driver?
;        beql    1$                      ;if eql yes, end search
;
; The somewhat odd layout here removes extra branches in the
; most common case, i.e., finding our driver the very first time
; through. The "bneq" branch next time is usually NOT taken.
;
	bneq	5$			;check next in chain if not us
; At this point R10 contains the DDT address within the intercept
; driver's UCB. Return the address of the intercept driver's UCB next.
        movab   <0-ucb$a_vicddt>(r10),r11       ;point R11 at the intercept UCB
;	brb	4$	; note in this layout we can comment this out.
4$:
        forkunlock lock=ucb$b_flck(r5),newipl=(sp)+,preserve=NO
; NOW clobber r0 and put things back.
	movl	r11,r0
;	popr	#^m<r10,r11>
	popl	r11
	popl	r10	;supposedly faster than popr
	rsb
; Make very sure this DDT is inside a UCB bashed according to our
; specs. The "p.magic" number reflects some version info too.
; If this is not so, not much sense searching more.
5$:     cmpl    <ucb$l_icsign-ucb$a_vicddt>(r10),#p.magic
        bneq    3$                     ;exit if this is nonstd bash
; follow DDT block chain to next saved DDT.
        movl    <ucb$l_prevddt-ucb$a_vicddt>(r10),r10
                                        ;point R10 at the next DDT in the
					;chain
        bgeq    3$                     ; (error check if not negative)
        brb     2$                      ;then check again
;1$:
3$:
	clrl	r11	;return 0 if nothing found
	brb	4$
;
; Few macros for long distance branches...
;
	.macro	beqlw	lbl,?lbl2
	bneq	lbl2
	brw	lbl
lbl2:
	.endm
	.macro	bneqw	lbl,?lbl2
	beql	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.
; This macro makes it easy to zero an allocated area before using it.
; Leaves no side effects...just zeroes the area for "size" bytes
; starting at "addr".
	.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
;
	.SBTTL Our FDT Filter Routines
; These routines are edited from the JTdriver versions to call
; getJTucb, assuming they are called with R5 pointing at the patched
; driver's UCB.
; INPUTS:
; 
; 	R3	- IRP ADDRESS (I/O REQUEST PACKET)
; 	R4	- PCB ADDRESS (PROCESS CONTROL BLOCK)
; 	R5	- UCB ADDRESS (UNIT CONTROL BLOCK)
; 	R6	- CCB ADDRESS (CHANNEL CONTROL BLOCK)
; 	R7	- BIT NUMBER OF THE I/O FUNCTION CODE
; 	R8	- ADDRESS OF FDT TABLE ENTRY FOR THIS ROUTINE
; 	(AP)	- ADDRESS OF FIRST QIO PARAMETER
; Filter routines.
; These do the interesting stuff.
;
;AccFilt: Handles open (io$_access) requests.
; Operation:
; 1. Check that access is really OK here (not our own daemons, not
;	our own internal I/O, either dummy FID to call daemon at once
;	or not in our job, and that function has io$m_access bit
;	set if not a bogus fid (& relevant fcnmsk bit).
; 2. Store the I/O context (registers etc.) in a structure called
;	our Local Data Table (LDT)
; (note: skip 2-5 if dummy FID & just call daemon if needed)
; 3. Start an i/o thread to read the ACL in. Note we make mainline wait
;	via waitfor ef#31 and loop till our local data structure says
;	we got r0 return from USER'S i/o. Flag nodelete till done
;	unless it was set at start. Use per-process counter to do
;	the nodelete state right.
; 4. If our ACE is there (3rd long containing "GCEV") then store it in
;	our structure for later. Junk stuff we don't need any more.
; 5. ASTs (knl, -> sp. knl) of internal I/O get to skast state.
; 6. If ACE says to call daemon, or if ACL not all there and our ACE not
;	seen, call daemon (in latter case flagging to read ACL one ACE at
;	a time)
; 7. Either direct or from SKAST from daemon return, restore regs
;	& context and issue user i/o. Unblock mainline once we get
;	r0 status from that i/o (return approp. value) and undo
;	no-delete, no-suspend flagging of process. Free knl stuff if
;	no need for it, or leave it for delete FDT processing.
;
AccFilt: $driver_fdt_entry
; skip kernel channels
	bitb	#3,irp$b_rmod(r3)	;see if any nonknl bits are there
	bneq	1$			;if neq yes, ok to continue
2$:
	bsbw	pors
	ret
;	brw pors			;no, cannot munge knl packet
1$:
; Also check quotas like the DEC FDT routines do to ensure quotas are
; not going to be violated. No need to go further if so.
	movl	pcb$l_jib(r4),r1	;get the JIB
	.if	df,evax
	tstl	jib$l_filcnt(r1)	;got any files left?
	.iff
	tstw	jib$w_filcnt(r1)	;got any files left?
	.endc
	bleq	2$			;no, skip now.
;check device not mounted, mounted, shadowset part etc.
	bbs	#dev$v_dmt,ucb$l_devchar(r5),2$
	bbc	#dev$v_mnt,ucb$l_devchar(r5),2$
	bitl	#<DEV$M_SSM!DEV$M_SHD>,ucb$l_devchar2(r5)
	bneq	2$
	bbs	#dev$v_for,ucb$l_devchar(r5),2$
; If both pcb$m_nounshelve and pcb$m_shelving_Reserved bits are
; set in PCB, omit the filtering.
	.if	df,pcbmsk$$
; if reserved shelving bit is clear we filter as usual
	bbc	#pcb$v_shelving_reserved,pcb$l_sts2(r4),502$
; if and only if both bits are set we skip out
	bbs	#pcb$v_nounshelve,pcb$l_sts2(r4),2$
502$:
	.endc
; Quotas and so on look OK. Can't economically check more here.
	pushr	#^m<r0,r5>
; original r5 now at 4(sp). Must get that to continue the ops.
	jsb	getJTucb		;find JTdriver ucb
	tstl	r0
	blss	509$
	popr	#^m<r0,r5>
	bsbw	popout
	ret
509$:
;	bgeqw	popout
	.iif df,msetrp,movl #1,mtp$trace(r0)
	movl	r5,ucb$l_backlk(r0)	;save link'd ucb in ours too.
	movl	r0,r5			;point R5 at JT UCB
	bitl	#1,ucb$l_ctlflgs(r5)	;doing this filtering?
	bneq	1509$
	popr	#^m<r0,r5>
	bsbw	popout
	ret
1509$:
;	beqlw	popout
; Make sure this isn't one of OUR daemons
	.iif df,msetrp,movl #2,mtp$trace(r5)
	.iif df,msetrp,movl r3,mtp$irp(r5)
	cmpl	pcb$l_pid(r4),ucb$l_daemon(r5)	;open etc. daemon?
	bneq	2509$
3509$:	popr	#^m<r0,r5>
	bsbw	popout
	ret
2509$:
;	beqlw	popout
	cmpl	pcb$l_pid(r4),ucb$l_exdmn(r5)	;not extend daemon
	beqlw	3509$
	cmpl	pcb$l_pid(r4),ucb$l_deldmn(r5)
	beqlw	3509$			;not delete daemon
	cmpl	pcb$l_pid(r4),ucb$l_exempt(r5)	;exempted pid?
	beqlw	3509$
	cmpl	pcb$l_pid(r4),ucb$l_exempt+4(r5) ;exempted pid?
	beqlw	3509$
	cmpl	pcb$l_pid(r4),ucb$l_exempt+8(r5) ;exempted pid?
	beqlw	3509$
	cmpl	pcb$l_pid(r4),ucb$l_exempt+12(r5) ;exempted pid?
	beqlw	3509$
;make sure not a knl mode channel (leave the XQP channel alone!!!)
	.iif df,msetrp,movl #3,mtp$trace(r5)
	cmpb	ccb$b_amod(r6),#1	;this the XQP's chnl?
; if less than 1 skip too...though that isn't supposed to happen
	bleqw	3509$			; if so scram NOW.
	bitl	#1024,ucb$l_ctlflgs(r5)	; checking for bogus FIDs?
	beql	3$			; if eql no
	.if	df,evax
	movl	irp$l_qio_p1(r3),r0	;get P1 param
	.iff
	movl	p1(ap),r0
	.endc
	beql	3$
	movl	4(r0),r0		;point at user FIB
	beql	3$			; skip if none there
; fid = fileno, fileseq, rvn, filenohi
; if filenohi .gt.128 and rvn .gt.128 as unsigned numbers then
; treat the operation here.
; Other h.o. bits are used to act as device switches here if this
; is selected. This requires of course that real volume sets
; be limited to maybe 32 volumes and that real maxfiles be less
; than the 24 bits' worth, for those volumes monitored here. Since
; this monitor is per disk, the function CAN just be disabled on large
; volume sets.
	bitb	#128,fib$w_fid+4(r0)	;rvn bit set?
	beql	3$
	bitb	#128,fib$w_fid+5(r0)	;hi fileno set?
	bneq	4$			;if so skip open funct. test
3$:
	.if	df,evax
	bitl	#<io$m_access>,irp$l_func(r3)	; see if this is really an OPEN
	.iff
	bitw	#<io$m_access>,irp$w_func(r3)	; see if this is really an OPEN
	.endc
	beqlw	3509$			;if not, scram
	brb	93$
4$:
; If here, we have a file id that appears fake and are flagging
; such. Arrange to call the daemon in that case.
; Note no LDT exists yet, so we'll do tests later, before issuing
; our own i/o, to test this.
93$:
; Ensure the file is not already open too, like DEC FDT routines do.
	.iif df,msetrp,movl #5,mtp$trace(r5)
	tstl	ccb$l_wind(r6)		;if a window exists, open now
	bneqw	3509$			;so scram fast.
;
; Now ensure that this call is not in the same JOB as the daemon.
; (This lets the daemon spawn processes to do some work.)
	pushr	#^m<r6,r7,r8,r9,r10,r11>	;get some regs
	movl	ucb$l_daemon(r5),r10	;get the daemon PID
	bleq	5$
	movzwl	r10,r7			;get process index
; like code in FQdriver...
	movl	 g^sch$gl_pcbvec,r6	;get pcb vector
	movl	(r6)[r7],r8		;get a PCB address
	tstl	r8			;ensure a system addr
	bgeq	5$			;skip if not
	cmpl	r10,pcb$l_pid(r8)	;be sure this is the daemon process
	bneq	5$			;else skip
; ok, we for sure have the daemon's PCB now. See if the JIBs match
	cmpl	pcb$l_jib(r8),pcb$l_jib(r4)	;same JIB as daemon's?
	bneq	5$			;if not, don't skip out
	popr	#^m<r6,r7,r8,r9,r10,r11>	;get regs back now
48$:	brw	3509$			;then buzz off
5$:
	popr	#^m<r6,r7,r8,r9,r10,r11>	;get regs back now
; Ensure this is not our own internal IRP by checking vs the AST address in
; the IRP.
	.iif df,msetrp,movl #6,mtp$trace(r5)
	movab	vcstp15,v15a
	.if	ndf,irp$q_qio_p1
	cmpl	v15a,irp$l_ast(r3)	;our IRP should be skipped
	.iff
	cmpl	v15a,irp$PQ_ACB64_ast(r3)	;our IRP should be skipped
	.endc
	beqlw	3509$
;
; Add "keep private volumes really private" by seeing if the volume
; owner (ucb$l_pid) is nonzero and if it is, if it does not match
; irp$l_pid then fail this i/o.
	.if	df,real_pvt
	pushl	r0
	bitl	#2048,ucb$l_ctlflgs(r5)	;2048 bit means keep pvt dvc pvt
	beql	148$
	movl	ucb$l_backlk(r5),r0	;get original ucb
	tstl	ucb$l_pid(r5)		;device owned by a pid?
	beql	148$			;if eql no, skip out
	tstl	irp$l_pid(r3)		;can't check internal irps
	blss	148$
	cmpl	irp$l_pid(r3),ucb$l_pid(r5)	;this i/o from owner?
	beql	148$			;yah...let it by
; I/O from someone else. Return error...
	popl	r0
	popr	#^m<R0,R5>		;restore regs now
	movl	#ss$_drverr,r0		;this is the error
	call_abortio
;	ret
;	jmp	g^exe$abortio		;so stop the open HERE.
148$:
	popl	r0
	.endc
; if we want to check only files in our store, do the following...
; In some cases this will reduce overhead a LOT.
	.iif df,msetrp,movl #7,mtp$trace(r5)
	bitl	#^x40000,ucb$l_ctlflgs(r5)	;check magic bit
	beql	50$
	pushr	#^m<r0,r1,r2,r3>	;need some regs
	.if	df,evax
	movl	irp$l_qio_p1(r5),r0	;get FIB desc
	.iff
	movl	p1(ap),r0
	.endc
	beql	47$
	movl	4(r0),r0		;get fib addr
	beql	47$
	movzwl	fib$w_fid(r0),r1	;get file number (check numbers
					; to save space)
	beql	47$			; look, don't skip, if no filenum
	.if	df,wd.lst
	movl	#f.nums,r2		; get size of store
	movab	ucb$l_fnums(r5),r3	; point at store
49$:	cmpw	(r3)+,r1		; same file number?
	beql	47$			; if so go ahead
	sobgtr	r2,49$
	.iff	;bitmap
	.iif	ndf,f.nums,f.nums=16
	.iif	ndf,f.nsiz,f.nsiz=2048
	movl	#f.nsiz,r2		; size of array
	movl	ucb$l_fnums(r5),r3	; get storage area
	beql	47$			; no bitmap means look
; r1 is file number...
	.iif	ndf,f.mask,f.mask=-16384 ;max bits to use in bitmap check
	bicl	#f.mask,r1		;clear extra bits
	ashl	#-3,r1,r2		;r2 gets byte offset into bitmap
	addl3	r3,r2,r0		;get the address
	bicl	#-8,r1			;isolate bit in byte now (0-7)
	bbs	r1,(r0),47$		;if the bit is zero, not here
					;if the bit is set, though, go fer it
	.endc
; fall thru...no match
	popr	#^m<r0,r1,r2,r3>
	popr	#^m<r0,r5>
	bsbw	popout
	ret
47$:
	popr	#^m<r0,r1,r2,r3>
50$:
; Looks like we need to deal with this IRP.
; First allocate some space to save the I/O context and find where this
; operation's LDT should be added.
; Do this from device IPL and save registers since we need them here.
	pushl	r0
	pushl	r1
	pushr	#^m<r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	tstl	ucb$l_prcvec(r5)	;got our process data area already?
	blss	131$			;if so skip grabbing now.
	pushr	#^m<r0,r1,r2,r3>
	movl	g^sch$gl_maxpix,r1
	ashl	#5,r1,r1		;get 32 bytes per process
; link to LDT
; ccb addr
; proc. counter of enable/disable deletion
; finish count for our thread, bumped before we do i/o, decremented when
;	user's i/o r0 return avail.
;
pv.ldt=0
pv.ccb=4
pv.eds=8
pv.fin=12
pv.pid=16	;pid if doing nt type security, else 0
	pushl	r1
	jsb	g^exe$alonpagvar	;get some pool
	popl	r1
	blbc	r0,31$
	zapz	(r2),r1			;zero it all initially
	movl	r2,ucb$l_prcvec(r5)	;set initial pointer in UCB
; now grab filenum bitmap store
	.if	ndf,wd.lst
	.iif	ndf,f.nsiz,f.nsiz=2048
	clrl	ucb$l_fnums(r5)
	movl	#f.nsiz,r1		;bytes to get
	jsb	g^exe$alonpagvar	;get some pool
	blbc	r0,31$
	movl	r2,ucb$l_fnums(r5)
	zapz	(r2),r1
31$:
	.endc
	popr	#^m<r0,r1,r2,r3>
131$:
; device IPL for this pseudo device is 8, same as fork!!!
	devicelock lockaddr=ucb$l_dlck(r5), -
	 lockipl=ucb$b_dipl(r5),preserve=YES
	.iif df,msetrp,movl #8,mtp$trace(r5)
	jsb	findldt			;get our LDT if any. (normally none)
	tstl	r0			;did we find one ready?
; must reallocate if we found one...should never get one twice
	beql	55$			;if eql, good, no LDT. Grab one from pool.
;got an ldt. Free it up.
	pushl	r1
; point past this LDT so link is ok
	movl	ldt$l_fwd(r0),ldt$l_fwd(r1)	;remove this ldt from chain
; r0 = addr = ldt
	movl	ldt$l_fresiz(r0),r1	;get size
	jsb	g^exe$deanonpgdsiz	;free it
	popl	r1
;ok, now the bogus LDT is gone. Get a new one.
55$:
	.iif df,msetrp,movl #9,mtp$trace(r5)
	.iif df,msetrp, movl r1,mtp$r1(r5)
	tstl	r1		;got a valid pointer?
	beqlw	2000$		;if not, skip out
	pushl	r1
	movl	#ldt$l_size,r1	;ldt size to get
	jsb	g^exe$alonpagvar	;go get pool
	popl	r1
	.iif df,msetrp,movl r0,mtp$r0(r5)
	blbs	r0,56$		;if ok, go on
989$:	brw	2000$		;else skip out.
56$:
	.iif df,msetrp,movl #10,mtp$trace(r5)
	movl	r2,(r1)		;point link at this one
	.iif df,msetrp,movl r2,mtp$ldt(r5)
	movl	r1,r9		;save copy here
	clrl	ldt$l_fwd(r2)	;zero our fwd pointer
	movl	#ldt$k_clrsiz,r10
	zapz	(r2),r10	;clear entire LDT out fassstt
; now wee have the LDT created. Set it up.
	movl	#ldt$l_size,ldt$l_fresiz(r2)	;set up the size to free
	movl	r6,ldt$l_ccb(r2)	;claim the LDT for us
	movl	r2,r11		;want the LDT less volatile
; Need to set up the process structure here. Since findldt doesn't
; return it, wee need to get it directly off the UCB.
	pushr	#^m<r2,r3>
	.iif df,msetrp,movl #11,mtp$trace(r5)
	movl	ucb$l_prcvec(r5),r1	;start of ldt chain
	bgeq	999$		;lose if none
	movzwl	pcb$l_pid(r4),r2	;get index
	ashl	#5,r2,r2		;get tbl entry offset
; shift 5 so 32 bytes = 8 longs per entry
	addl3	r2,r1,r3		;point r3 at our slot
	movl	r3,r1			;let r1 return as link addr
999$:
	popr	#^m<r2,r3>
	.iif df,msetrp,movl #12,mtp$trace(r5)
	movl	r1,ldt$l_prcstr(r11)	;set up pointer to process struct
	bgeq	989$
	addl2	#8,ldt$l_prcstr(r11)	;pass LDT base info to get to our counters
; allocate the synch structure we need now.
; (if we keep ldt allocated till wait falls thru and dealloc after
;  then we may be able to just use the ldt here though.)
	movl	#16,r1
	jsb	g^exe$alonpagvar
	blbs	r0,57$			;if all well, fine
;no aux struct so skip out
	clrl	(r9)		;clr pointer to ldt
	movl	r11,r0		;addr to free
	movl	ldt$l_fresiz(r11),r1	;size to free
	jsb	g^exe$deanonpgdsiz
	brw	2000$		;skip out
57$:
	zapz	(r2),r1
	movl	r2,ldt$l_synch(r11)	;save pointer to synch block
	.iif df,msetrp,movl #13,mtp$trace(r5)
	clrq	(r2)			;set it initially null
	movl	r11,r1			;save ldt pointer
	.if	ndf,evxr64d
	movpsl	ldt$l_psl(r11)	;save original psl of request for later
	.iff
	evax_getps
	movl	r0,ldt$l_psl(r11)
	.endc
	insv	#2,#psl$v_ipl,#psl$s_ipl,ldt$l_psl(r11) ;enforce ipl2
	movab	ldt$l_regs(r11),r0	;where to save regs
	popr	#^m<r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	evax_stq r2,(r0)+
	evax_stq r3,(r0)+
	evax_stq r4,(r0)+
	evax_stq r5,(r0)+
	evax_stq r6,(r0)+
	evax_stq r7,(r0)+
	evax_stq r8,(r0)+
	evax_stq r9,(r0)+
	evax_stq r10,(r0)+
	evax_stq r11,(r0)+
;	movl	r2,(r0)+
;	movl	r3,(r0)+
;	movl	r4,(r0)+
;	movl	r5,(r0)+	;save all registers.
;	movl	r6,(r0)+	;use movl since we don't know its
;	movl	r7,(r0)+	;quadword aligned.
;	movl	r8,(r0)+
;	movl	r9,(r0)+
;	movl	r10,(r0)+
;	movl	r11,(r0)+	;save all registers
	.iif df,msetrp,movl #14,mtp$trace(r5)
	.iif	df,msetrp,movl r6,mtp$ccb(r5)
	pushr	#^m<r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	movl	r1,r11		;r11 is again the LDT
	movl	irp$ps_fdt_context(r3),ldt$l_fdtctx(r11) ;save FDT context addr
	.iif df,msetrp, movl irp$ps_fdt_context(r3),mtp$trc3+4(r5)
; now fix up saved R5 to point at original intercepted ucb
	movl	ucb$l_backlk(r5),ldt$l_regs+24(r11)
	movab	ldt$l_parm(r11),r0	;save qio params
	deviceunlock lockaddr=ucb$l_dlck(r5),newipl=#ipl$_astdel,preserve=YES
	.if	df,evax
; Note these addresses will be in 32bit space for the foreseeable future
; so it's OK to store only 32 bits here. If we started intercepting read
; or write or the like (where 64 bit addresses are used) we'd need to
; save all 64 bits.
	movl    irp$l_qio_p1(r3),(r0)+
	movl    irp$l_qio_p2(r3),(r0)+
	movl    irp$l_qio_p3(r3),(r0)+
	movl    irp$l_qio_p4(r3),(r0)+
	movl    irp$l_qio_p5(r3),(r0)
	.iff
	movl	p1(ap),(r0)+
	movl	p2(ap),(r0)+
	movl	p3(ap),(r0)+
	movl	p4(ap),(r0)+
	movl	p5(ap),(r0)+
	.endc
; get the params like user FIB stuff...
	.if	df,evax
	movl	irp$l_qio_p1(r3),r10	;fib desc.
	.iff
	movl	p1(ap),r10
	.endc
	movl	4(r10),r10		;point at fib ityself
	movl	fib$l_acctl(r10),ldt$l_accmd(r11)	;save "how open"
	clrb	ldt$l_accmd+3(r11)			;clear window size
	.iif df,msetrp,movl #15,mtp$trace(r5)
	.if	df,evax
	movl	pcb$l_prib(r4),ldt$l_bprio(r11)		;save base prio
	.iff
	movzbl	pcb$b_prib(r4),ldt$l_bprio(r11)		;save base prio
	.endc
; save file id, dir id from user call initially. Get file ID later after
; our i/o as a "better" number [should be the same].
	movl	fib$w_fid(r10),ldt$l_myfid(r11)
	movzwl	fib$w_fid+4(r10),ldt$l_myfid+4(r11)
	movl	fib$w_did(r10),ldt$l_mydid(r11)	;save dir id too
	movzwl	fib$w_did+4(r10),ldt$l_mydid+4(r11)
	movl	g^ctl$gl_phd,r9		;get proc. hdr
	movl	phd$q_privmsk(r9),ldt$l_wprv(r11)	;save working privs
	movl	phd$q_privmsk+4(r9),ldt$l_wprv+4(r11)	;save working privs
	movl	phd$q_authpriv(r9),ldt$l_aprv(r11)	;save auth privs
	movl	phd$q_authpriv+4(r9),ldt$l_aprv+4(r11)	;save auth privs
	.if	df,pcb$ar_natural_psb_def
; Allow mods of PSB based privs etc. if it exists.
; Get data from the PSB if it exists.
	movl	pcb$ar_natural_psb(r4),r9	; point at the PSB block
	movl	psb$q_authpriv(r9),ldt$l_aprv(r11)
	movl	psb$q_authpriv+4(r9),ldt$l_aprv+4(r11)
	movl	psb$q_permpriv(r9),ldt$l_wprv(r11)
	movl	psb$q_permpriv+4(r9),ldt$l_wprv+4(r11)
	.endc
	movl	r5,ldt$l_jtucb(r11)		;save jt ucb here too
; set up template, blast it into the LDT for item list
	movab	ldt$l_acl(r11),gceaba		;acl buffer address
	movab	ldt$l_aclsiz(r11),gceala		;length of acl
	movab	gceacl,r9			;point at template now
	movab	ldt$l_itmlst(r11),r8
	pushr	#^m<r0,r1,r2,r3,r4,r5>	;don't let movc3 trash these
	movc3	#gcetpl,(r9),(r8)	;copy filled-in template to our
					;itemlist in ldt
	popr	#^m<r0,r1,r2,r3,r4,r5>
;fib desc still in r10
	movab	ldt$l_fib(r11),r9	;copy user fib
	.if	df,evax
	movl	@irp$l_qio_p1(r3),r8	;get size user has
	.iff
	movl	@p1(ap),r8
	.endc
	cmpl	r8,#64
	bleq	59$			;if ok branch
	movl	#64,r8
59$:
	pushr	#^m<r0,r1,r2,r3,r4,r5>	;don't let movc3 trash these
	movc3	r8,(r10),(r9)		;copy user FIB
	popr	#^m<r0,r1,r2,r3,r4,r5>
	.iif df,msetrp,movl #16,mtp$trace(r5)
	bicl	#^xfff,fib$l_acctl(r9)	;no special open bits
;ensure fib has nothing special
	clrl	fib$l_aclctx(r9)	;no acl context
;
; An open might look up a filename so copy user desc too.
	.if	df,evax
	movl	irp$l_qio_p2(r3),r8	;get desc. pointer
	.iff
	movl	p2(ap),r8		;get desc pointer
	.endc
	beql	159$			;if no p2 arg, skip save
	movl	(r8),ldt$l_fnd(r11)	;copy user desc.
	cmpw	#255,ldt$l_fnd(r11)	;see if count to big
	bgeq	259$			;if geq all well
	movw	#255,ldt$l_fnd(r11)	;else chop off
259$:	movl	4(r8),r8		;point at user data now
	beql	159$
	pushr	#^m<r0,r1,r2,r3,r4,r5>	;don't let movc3 trash these
	movab	ldt$l_fndd(r11),r1	;our ldt data address
	movab	ldt$l_fndd(r11),ldt$l_fnd+4(r11) ;fill in data addr
	movzbl	ldt$l_fnd(r11),r0	;count to move
	beql	359$
	movc3	r0,(r8),(r1)		;copy filename string
359$:
	popr	#^m<r0,r1,r2,r3,r4,r5>
159$:
; Basically all set up now. Issue a $qio with an AST to point to the
; normal-knl-AST code and start waiting the mainline for ef #31 (the junk
; efn) and for the extra "iosb" area to get bumped. Block deletion of the
; process during this $qio by hand, counting this up and down per PROCESS.
	movl	ldt$l_prcstr(r11),r1	;get process data block

;	deviceunlock lockaddr=ucb$l_dlck(r5),newipl=#ipl$_astdel,preserve=YES

; Before issuing our I/O, see if this is a bogus file id
; that we let by earlier and route it to the daemon if so, directly
; without reading the ACL.
; R5 should still be pointing at the JT unit here since we issue another
; $qio which handles getting it moved...
	.iif df,msetrp,movl #17,mtp$trace(r5)
	bitl	#1024,ucb$l_ctlflgs(r5)	; checking for bogus FIDs?
	beqlw	103$			; if eql no
	.if	df,evax
	movl	irp$l_qio_p1(r3),r0	;get P1 param
	.iff
	movl	p1(ap),r0
	.endc
	beqlw	103$
	movl	4(r0),r0		;point at user FIB
	beqlw	103$			; skip if none there
; fid = fileno, fileseq, rvn, filenohi
; if filenohi .gt.128 and rvn .gt.128 as unsigned numbers then
; treat the operation here.
; Other h.o. bits are used to act as device switches here if this
; is selected. This requires of course that real volume sets
; be limited to maybe 32 volumes and that real maxfiles be less
; than the 24 bits' worth, for those volumes monitored here. Since
; this monitor is per disk, the function CAN just be disabled on large
; volume sets.
	bitb	#128,fib$w_fid+4(r0)	;rvn bit set?
	beql	105$
	bitb	#128,fib$w_fid+5(r0)	;hi fileno set?
	beql	105$			;if so skip open funct. test
; If here, we have a file id that appears fake and are flagging
; such. Arrange to call the daemon in that case.
; Note no LDT exists yet, so we'll do tests later, before issuing
; our own i/o, to test this.
; LDT pointer in R11 here.
	movl	r11,r0
	movl	r5,r1
	popr	#^m<r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	movl	r0,r11
	movl	r1,r0
	popl	r1
	popl	r1	;leave r0 alone
; now stack is clean except of <r0,r5> push
	popl	r5		;get original r5 back
	tstl	(sp)+		;& remove saved r0
; Now replace regs on stack, but we do leave R11 pointing at LDT.
; Since R11 is scratch for FDT routines, this is ok. Other
; stacked regs in r2-r10 range get left alone but we
; continue with r5 = JT UCB (stacked r5=victim ucb).
	pushr	#^m<r3,r4,r5,r6,r7,r8,r9,r10,r11>
	movl	r0,r5		;set r5 to jt ucb
	pushr	#^m<r0,r1,r2>	;now stack is same as
				;after push of r0-r11
; Note fake FID handling not defined yet.
	.iif df,msetrp,movl #1017,mtp$trace(r5)
	brw	afakfid		;go handle fake fids
105$:
103$:
; (r1) = count up/down our knl threads
; 4(r1) = disable delete counter
	.iif df,msetrp,movl #18,mtp$trace(r5)
	tstl	4(r1)			;is del inhibited now?
	bgtr	61$
	incl	(r1)			;count knl thread up here.
	bitl	#<pcb$m_nodelet!pcb$m_nosuspend>,pcb$l_sts(r4)	;is delete inhibited now?
	bneq	160$			;if so leave it alone
61$:	incl	4(r1)			;bump inhibit counter once more
	bisl	#<pcb$m_nodelet!pcb$m_nosuspend>,pcb$l_sts(r4)	;inhib del
160$:
	movl	ldt$l_synch(r11),r10	;point r10 at the synch block
; the $qio will return with all regs except r0,r1
; First have to get the channel number from the CCB address which was passed
; in R6 so we can use the channel for OUR $qio.
;
; This is system dependent.
	.if	df,evax	;evax defined for alpha
	movl	r6,r12		;deduced from sysqioreq src
	subl2   g^ctl$ga_ccb_table,r12  ;subtract base address
	ashl	#-5,r12,r12     ;divide by ccb$k_length = 32
;	assume ccb$k_length eq 32
	incl	r12		;1-based
	pushl	r13
	bicl3	#^c<^x0000f000>,r12,r13	;r13 -> hi 4 bits
	bicl2	#^xf000,r12	;get low 12 bits masked off
	ashl	#4,r12,r12	;shift 12 up
	ashl	#-12,r13,r0	;shift the 4 down
	bisl	r0,r12		;merge
	movzwl	r12,r12		;ensure h.o. bits off
	popl	r13		;restore borrowed reg
; r12 is now channel
	movl	r12,r8
	.iff	;vax vers
	movl	r6,r8
	subl2	g^ctl$gl_ccbbase,r8	;form -chnl
	mnegl	r8,r8
	movzwl	r8,r8			;r12 should be channel now
	.endc
; now issue the $qio
; form descriptor for fib on stack
	pushl	r11		;be VERY sure we keep valid ldt ptr
	.if	df,evaxrr
	movl	sp,r12		;save sp in r12
; now force sp to be octa-aligned
	bicl	#15,sp		;just clear low bits
	.endc
	subl	#16,sp		;get 4 longs
	movl	sp,r10		;descriptor is len, addr
	movl	#64,(r10)
	movab	ldt$l_fib(r11),4(r10)	;(r10) is descriptor of fib now.
	movl	#gcetpl,8(r10)	;length of itemlist
	movab	ldt$l_itmlst(r11),12(r10)	;now have descriptor for itmlst
	.if	df,evax
	.if	df,drctcl
	subl2	#40,sp
	evax_stq	r12,(sp)
	evax_stq	r13,8(sp)
	evax_stq	r14,16(sp)
	evax_stq	r15,24(sp)
	evax_rd_ps
	evax_or		r0,r31,r15		;store old ps
	evax_stq	r15,32(sp)		; save old ps on stack. Safer.
;clear low 2 bits of r0 (previous mode)
	bicl	#3,r0			;prev mode MUST be kernel next.
	evax_or		r0,r31,r16	;set r16 prev-mode bits to zero
	evax_wr_ps_sw			;set prev mode to kernel
	.endc
	.endc
;begin the $qio here
	clrl	-(sp)		;p6
	movl	12(r10),-(sp)	;p5
	clrl	-(sp)		;p4
	clrl	-(sp)		;p3
; Where user open involves a dir lookup, we might need one too.
; Therefore supply the filename he used if we found one.
	tstl	ldt$l_fndd(r11)	;got a p2?
	bneq	459$		;if so fill in
	clrl	-(sp)		;p2 zero if none here
	brb	559$
459$:	pushab	ldt$l_fnd(r11)	;p2 as our copy of user p2 in knl space
559$:
	movab	(r10),-(sp)	;p1
	movl	r11,-(sp)	;ast parm = LDT address
	movab	vcstp15,-(sp)	;ast address = vcstp15 (step 1.5 of thread)
	movl	ldt$l_synch(r11),-(sp)	;iosb = synch + 8
	addl2	#8,(sp)		;this gives us a way to getthe status for debug
	tstl	(sp)		;ensure negative
	blss	659$
	clrl	(sp)		;if synch addr illegal use 0
659$:
;	clrl	-(sp)		;no iosb
	movl	#io$_access,-(sp)	;function
	movl	r8,-(sp)	;channel number
	movl	#31,-(sp)	;junk event flag
	movl	g^ctl$gl_pcb,r4		;point at our PCB just in case
	.if	df,msetrp
	pushl	r10
	movl	ldt$l_jtucb(r11),r10	;get jt ucb
	movl	r8,mtp$chan(r10)
	movl	#18,mtp$trace(r10)
	popl	r10
	.endc
	.if	df,evax
; exe$qio expects to be entered at ipl 0.
	setipl ipl=#0,environ=UNIPROCESSOR
; call exe$qio without extra chmk dispatch (which might mess stack up)
qiooff = 29	;index into dispatch table for sys$qio (determined by inspecting
			; code)
	movl	g^PMS$GL_KERNEL_DISPATCH_VECTOR,r0
;	movab	g^cmod$ar_kernel_dispatch_vector,r0	;procedure desc
	addl2	#<16*qiooff>,r0			;form addr of qio prc desc
	movl	(r0),r0		;load procedure descr addr into r0
	.if	df,drctcl
	calls	#12,(r0)
	.iff
	calls	#12,g^sys$qio	;do the i/o
	.endc	;drctcl
	.if	df,drctcl
	evax_ldq	r16,32(sp)	;get original ps
	evax_wr_ps_sw		;restore original prev. mode
	evax_ldq	r13,8(sp)
	evax_ldq	r12,(sp)
	evax_ldq	r14,16(sp)
	evax_ldq	r15,24(sp)
	addl2	#40,sp
	.endc
	.iff
; force curr, prev mode to knl (=0) before issuing the request here.
	movpsl	-(sp)	;force prev knl mode too
	bicl	#<psl$m_prvmod+psl$m_curmod>,(sp)
	insv	#0,#psl$v_ipl,#psl$s_ipl,(sp) ;sys services like ipl 0 on vax
	pushab	158$
	rei		;continues at 158$ with stack clear
158$:
	.if	ndf,ee$qq
	calls	#12,g^exe$qio	;do the i/o (kernel entry!!!)
	.iff
	calls	#12,g^sys$qio	;do the i/o (kernel entry!!!)
	.endc
	.endc
	setipl	ipl=#2,environ=UNIPROCESSOR	;back to astdel
	addl2	#16,sp		;clean the stack.
	.if	df,evaxrr
	movl	r12,sp		;get original pre-call sp back
	.endc
	popl	r11
	.if	df,msetrp
	pushl	r10
	movl	ldt$l_jtucb(r11),r10	;get jt ucb
	movl	r0,mtp$ior0(r10)

	movl	#19,mtp$trace(r10)
	popl	r10
	.endc
; r11 should still be the LDT address, R10 the synch block address.
;	blbc	r0,500$		;if the I/O failed, we lose. Try to just issue
	blbs	r0,3500$
	brw	500$
3500$:
				;the user's i/o.
	.if	ndf,evax
	movl	ldt$l_psl(r11),-(sp)	;get to original I/O PSL
	jsb	301$
	brb	302$
301$:	rei
302$:
	.endc
	.if	df,evxrei
	movl	ldt$l_psl(r11),-(sp)	;get to original I/O PSL
	clrl	-(sp)
	pushab	301$			; get 4 byte addr
	movl	#-1,-(sp)		; now have pc,ps on stack as 8 bytes
	evax_stq	r7,-(sp)
	evax_stq	r6,-(sp)
	evax_stq	r5,-(sp)
	evax_stq	r4,-(sp)
	evax_stq	r3,-(sp)
	evax_stq	r2,-(sp)	;ready for PAL call
	evax_imb
	evax_rei
	addl2	#64,sp		;never execute but keep macro-32 happy
301$: 
	.endc
	.if	df,evxr64d
	pushl	r0
	pushl	r1
	pushl	ldt$l_psl(r11)	;get original psl
	calls	#1,g^evxr64
	popl	r1
	popl	r0
	.endc
; if ldt got deallocated before here, could be disaster.
	movl	ldt$l_synch(r11),r10	;status blk address
	jsb	dowait		;await done
	movl	r10,r0		;r0 status from user's I/O here usually now
; Now that dowait is done we can free the LDT with no fear of having it
; deallocated out from under dowait.
	setipl ipl=#2,environ=UNIPROCESSOR
	pushl	r0
;
; Now we can deallocate either the whole LDT or the part below the
; ACE.
; Rather than fiddle, leave the whole ACE buffer there, chopping
; off after it.
; LDT is pointed at by R11 here.
; Note we have our regs back because fdtlop etc. saves all in its
; entry mask. Thus the regs are original qio regs. For findldt we
; need r5=JT unit UCB though, so get that.
	evax_ldq r5,ldt$l_regs+24(r11)
;	movl	ldt$l_regs+24(r11),r5	;original ucb
	jsb	getjtucb	;find JT UCB again
	tstl	r0		;lose if we cannot
	beql	86$		;
	movl	r0,r5		;now r5=JT ucb
	devicelock lockaddr=ucb$l_dlck(r5), -
	 lockipl=ucb$b_dipl(r5),preserve=YES
	pushl	r5
	.iif df,msetrp, movl #1433,mtp$trace(r5)
	clrl	ldt$l_softf(r11)	;zero softlink flag
	cmpl	ldt$l_ace+8(r11),acllit	;this our ACE?
	beql	80$			;if eql we must keep the ace till close
; clean all out
	jsb	findldt		;find where this LDT is
; On return r1 is previous LDT (which we need) and r0 is
; LDT address (must be same as R11).
	cmpl	r0,r11
	bneq	85$		;if we get bad LDT, don't mess
; r1 is prev LDT, r11 is this one.
	movl	ldt$l_fwd(r11),ldt$l_fwd(r1)	;collapse this LDT out of chain
; If this is the LAST LDT, just to be safe, clear paranoid mode.
; r5 is jt ucb now, R11 is LDT address
	jsb	chklast			;check for last LDT
;now deallocate this LDT & go
	movl	ldt$l_fresiz(r11),r1		;length to free
	movl	r11,r0			;addr to free
; first get the FDT context area address. Will be in R1 when we pop
; the following registers.
	movl	ldt$l_fdtctx(r11),r9	;get fdt context area
	jsb	g^exe$deanonpgdsiz	;free it
	brw	85$
80$:
; shorten by reallocate/copy/delete
	jsb	findldt
	cmpl	r0,r11
	bneq	85$		;if we get bad LDT, don't mess
	movl	r1,r10		;move prev-ldt addr to r10...keep from harm
	movl	#ldt$l_regs,r1	;length to allocate
	jsb	g^exe$alonpagvar
	blbc	r0,85$		;leave LDT alone if we can't grab less
	movl	r2,r9		;new addr save
	movc3	#ldt$l_regs,(r11),(r9)	;copy 1st part of LDT
; now free the old LDT after we move linkage.
	movl	#ldt$l_regs,ldt$l_fresiz(r9)	;set size as less
	movl	r9,ldt$l_fwd(r10)	;point prev. LDT at this.
	movl	ldt$l_fresiz(r11),r1
	movl	r11,r0		;dealloc old ldt
; first get the FDT context area address. Will be in R1 when we pop
; the following registers.
	movl	ldt$l_fdtctx(r11),r9	;get fdt context area
	jsb	g^exe$deanonpgdsiz	;free it
; now old LDT should be free so we're done.
85$:
	popl	r5
	deviceunlock lockaddr=ucb$l_dlck(r5),newipl=#ipl$_astdel,preserve=YES
86$:
	popl	r0
; get all the saved regs off the stack
; return r1 as fdt context address we saved in r9 above
	.if	df,vxrgo
	movl	r9,44(sp)	;final pop of r1 gets it
	.iff
	movl	r9,r12	; use an axp reg
	.endc
; this way the caller's R9 is unaltered due to the pop
	popr	#^m<r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	popl	r1
	popl	r1		;leave r0 alone but clean stack
	.iif ndf,vxrgo, movl r12,r1	;get fdt ctx area to r1
	brw	510$

; here at 500$ if I/O failed!!!
500$:
	movl	r11,r0		;save LDT pointer in r0
; (need LDT at stp2bad)
	popr	#^m<r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	popl	r1
	popl	r1		;leave r0 alone
;stp2bad preserves all regs via save/restore.
; first get the FDT context area address. Will be in R1 when we pop
; the following registers.
	movl	ldt$l_fdtctx(r0),r1	;get fdt context area
	movl	r0,r11
	pushl	r11
	bsbw	stp2bad		;go try & resume i/o
	setipl ipl=#2,environ=UNIPROCESSOR
; R11 can be scratched in fdt code since it gets restored on exit from
; the system service.
	popl	r11
	movl	#ss$_accvio,r0	;set generic error
;
; free the ldt now to keep it clean.
	pushr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
; Now we can deallocate either the whole LDT or the part below the
; ACE.
; Rather than fiddle, leave the whole ACE buffer there, chopping
; off after it.
; LDT is pointed at by R11 here.
; Note we have our regs back because fdtlop etc. saves all in its
; entry mask. Thus the regs are original qio regs. For findldt we
; need r5=JT unit UCB though, so get that.
	evax_ldq r5,ldt$l_regs+24(r11)
;	movl	ldt$l_regs+24(r11),r5	;original ucb
	jsb	getjtucb	;find JT UCB again
	tstl	r0		;lose if we cannot
	beql	3086$		;
	movl	r0,r5		;now r5=JT ucb
	pushl	r5
	devicelock lockaddr=ucb$l_dlck(r5), -
	 lockipl=ucb$b_dipl(r5),preserve=YES
;	cmpl	ldt$l_ace+8(r11),acllit	;this our ACE?
;	beql	3080$			;if eql we must keep the ace till close
; clean all out
	jsb	findldt		;find where this LDT is
; On return r1 is previous LDT (which we need) and r0 is
; LDT address (must be same as R11).
	cmpl	r0,r11
	bneq	3085$		;if we get bad LDT, don't mess
; r1 is prev LDT, r11 is this one.
	movl	ldt$l_fwd(r11),ldt$l_fwd(r1)	;collapse this LDT out of chain
; If this is the LAST LDT, just to be safe, clear paranoid mode.
; r5 is jt ucb now, R11 is LDT address
	jsb	chklast			;check for last LDT
;now deallocate this LDT & go
	movl	ldt$l_fresiz(r11),r1		;length to free
	movl	r11,r0			;addr to free
	jsb	g^exe$deanonpgdsiz	;free it
	brw	3085$
3080$:
;; shorten by reallocate/copy/delete
;	jsb	findldt
;	cmpl	r0,r11
;	bneq	3085$		;if we get bad LDT, don't mess
;	movl	r1,r10		;move prev-ldt addr to r10...keep from harm
;	movl	#ldt$l_regs,r1	;length to allocate
;	jsb	g^exe$alonpagvar
;	blbc	r0,3085$		;leave LDT alone if we can't grab less
;	movl	r2,r9		;new addr save
;	movc3	#ldt$l_regs,(r11),(r9)	;copy 1st part of LDT
;; now free the old LDT after we move linkage.
;	movl	#ldt$l_regs,ldt$l_fresiz(r9)	;set size as less
;	movl	r9,ldt$l_fwd(r10)	;point prev. LDT at this.
;	movl	ldt$l_fresiz(r11),r1
;	movl	r11,r0		;dealloc old ldt
;	jsb	g^exe$deanonpgdsiz	;free it
; now old LDT should be free so we're done.
3085$:
	popl	r5
	deviceunlock lockaddr=ucb$l_dlck(r5),newipl=#ipl$_astdel,preserve=YES
3086$:
	popr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
510$:
	pushl	r1
	pushl	r0		;ensure waits run
	movl	#31,-(sp)	;junk event flag
	calls	#1,g^sys$setef
	popl	r0		;get status back
	popl	r1
; Must now flush the pushr of <r0,r5> off stack.
	popl	r5		;get saved <r0,r5> r5 = ucb pointer
	tstl	(sp)+		;fix stack, leave r0 alone
; For step2 we must store r0 in fdt_context structure, which is
; located by IRP$PS_FDT_CONTEXT in the IRP for the original user
; IRP; this returns the intermediate return status to the user.
; Return dd$_fdt_compl in r0 at this point in step2, and real status
; in the fdt_context area at FDT_CONTEXT$L_QIO_STATUS and
; perhaps FDT_CONTEXT$L_QIO_R1_VALUE as needed.
; This needs to be gathered from the user's I/O appropriately too.
; Note that the LDT has the cell ldt$l_fdtctx which is the address
; of the user's FDT context area. That should be used since the IRP
; is invalid by the time we get here. Our pointer is not.

; !!!! note that the LDT is now deallocated. Must get fdt context
; before this...

;;;;	movl	ldt$l_fdtctx(r11),r1	;get fdt context area
; here see if r1 is fdt context area!!
	movl	r0,fdt_context$l_qio_status(r1)	;save status
	movl	#ss$_fdt_compl,r0	;normal fdt donesignal
	clrl	irp$ps_fdt_context(r3)	;clear fdt context
	setipl ipl=#0,environ=UNIPROCESSOR
	ret
;	jmp	g^exe$qioreturn	;do intermediate exit.

2000$:
	deviceunlock lockaddr=ucb$l_dlck(r5),newipl=#ipl$_astdel,preserve=YES
	popr	#^m<r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	popl	r1
	popl	r0
	popr	#^m<r0,r5>
	bsbw	popout
	ret
;	brw	popout		;leave
; handling for fake FIDs, not yet implemented so just return.
afakfid:
	popr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	bsbw	popout
	ret

; clnprv
clnprv:	.jsb_entry
	pushr	#^m<r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
;entry r5 is victim ucb addr
	jsb	getjtucb	;get jt ucb
	tstl	r0
	bgeq	99$
	movl	r0,r5		;r5 now is jt ucb
	movl	r0,r10		;set for clnup
	jsb	clnupnd		; clean privs etc but do NOT delete LDT here
	movl	r5,r0
	movl	r10,r1
99$:
	popr	#^m<r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	rsb;
; prvidset
; This entry reads the ACE and sets privs/idents/base prio of
; the process based on what the ACE has.
; On entry R11 contains the LDT pointer.
prvidset: .jsb_entry
	pushr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	.if	df,ktb$ar_psb
; Be sure that we modify privs or ids ONLY if doing so to the natural PSB
; and not some other personna (which might not endure). Altering privs
; and so on at file open is only sensible if personnae are not at issue
; or else it's pretty senseless. Therefore just leave them alone if
; not the default.
	movl	g^ctl$gl_pcb,r4
	cmpl	ktb$ar_psb(r4),pcb$ar_natural_psb(r4)
	bneqw	999$
	.endc
	movab	ldt$l_ace(r11),r10	;point at our ACE
; look for priv sets
	cmpl	ldt$l_ace+8(r11),acllit	;this our ACE?
	bneqw	999$
	movab	12(r10),r10	;start of data
1$:	movzbl	(r10)+,r9	;get fcn byte
	beqlw	999$
	cmpb	r9,#1		;inspectme => not here
	beql	1$
	cmpb	r9,#2		;moveme
	beql	1$
	cmpb	r9,#3		;base prio set?
	bneq	2$		;if not look more
; set base prio if ok
	cvtbl	(r10)+,r8	;prio to use to r8
	movl	(r10)+,r7	;one long of sec.info
	movl	ldt$l_myfid(r11),r2	;file id
	movl	ldt$l_myfid+4(r11),r3	;hi fileid
	clrl	r1
	movl	r8,r0
	jsb	auth		;compute auth key
	cmpl	r0,r7		;check against ace
	bneq	1$		;if no good look more
; ok...set base prio
	movl	g^ctl$gl_pcb,r4
	.if	df,evax
	movl	r8,pcb$l_prib(r4)	;set base prio (axp)
	.iff
	movb	r8,pcb$b_prib(r4)	;set base prio (axp)
	.endc
	brw	1$
2$:
	cmpb	r9,#4		;priv set?
	bneq	3$		;if neq look more
	movl	(r10)+,r0	;sec info
	movl	r0,r7
	movl	(r10)+,r1	;sec info
	movl	r0,r8
	movl	ldt$l_myfid(r11),r2	;file id
	movl	ldt$l_myfid+4(r11),r3	;hi fileid
	jsb	auth
	movl	(r10)+,r2	;get info from ace
	movl	(r10)+,r3
	cmpl	r0,r2		;check auth info
	bneq	3$
	cmpl	r1,r3
	bneq	3$
; set privs to mask.
	movl	g^ctl$gl_pcb,r4
	movl	r7,pcb$q_priv(r4)
	movl	r8,pcb$q_priv+4(r4)
	movl	r7,g^ctl$gq_procpriv
	movl	r8,g^ctl$gq_procpriv+4
	movl	g^ctl$gl_phd,r4
	movl	r7,phd$q_authpriv(r4)
	movl	r8,phd$q_authpriv+4(r4)
	movl	r7,phd$q_privmsk(r4)
	movl	r8,phd$q_privmsk+4(r4)
	brw	1$
3$:	cmpb	r9,#5		;ident set?
	bneq	4$
	movl	(r10)+,r0	;sec info (identifier hi)
	movl	r0,r7
	movl	(r10)+,r1	;sec info (identifier lo)
	movl	r0,r8
	movl	ldt$l_myfid(r11),r2	;file id
	movl	ldt$l_myfid+4(r11),r3	;hi fileid
	jsb	auth
	movl	(r10)+,r2	;get info from ace
	movl	(r10)+,r3
	cmpl	r0,r2		;check auth info
	bneq	34$
	cmpl	r1,r3
	bneq	34$
; grant identifier in r7,r8 to curr. process.
	clrq	-(sp)		;clear privatr & procname cells
	movab	-16(r10),-(sp)	;addr of identifier info
	clrq	-(sp)		;null pid & prcname
	calls	#5,grantid	;use internal code (from vms)
	brw	1$
34$:	clrq	-8(r10)		;zero the identifier if it didn't
				;authenticate, so we don't revoke it
				;later
	brw	1$
4$:	cmpb	r9,#6		;softlink record?
	bneq	5$		;skip out if illegal value
	movzbl	(r10),r9	;get length of data
	addl2	r9,r10		;add to pointer
	brw	1$
5$:	cmpb	r9,#7		;temp tag?
	bneqw	999$		;if ill value scram
	movzbl	(r10),r9	;get length
	addl2	r9,r10
	brw	1$
999$:
	popr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	rsb
; auth -
; call: r0,r1 = security info
;       r2,r3 = file ID
;       ucb$l_keycry key; ucb ptr in r5
; output in r0,r1 = auth string
auth: .jsb_entry output=<r0,r1>
; simple minded scrambler
; However not TOO simple minded. Don't want this to introduce a
; new security hole so do xors and some funny checksum adds
	xorl2	r3,r0
	xorl2	r2,r1
	xorl2	ucb$l_keycry(r5),r0
	xorl2	ucb$l_keycry+4(r5),r1	;bunch of xors to scramble
; now xor once more with a constant
	xorl2	#^x5218fba2,r0
	xorl2	#^xaba7126c,r1	
	pushl	r0
	pushl	r1
	ashl	#3,r0,r0
	addl2	r0,r1
	addl2	r2,r1
; (sp) is old r1
;4(sp) is old r0
	addl2	r1,4(sp)
	movzwl	ucb$l_keycry+5(r5),r1
	addl2	r1,4(sp)
	movl	(sp),r1		;get old r1
	ashl	#5,r1,r1
	addl2	r3,r1
	addl2	r1,(sp)		;mix up r1
	movzwl	ucb$l_keycry+1(r5),r1
	addl2	r1,(sp)
;for weirdness use a couple ffs's
	ffs	#0,#32,(sp),r1
	addl2	r1,4(sp)
	ffs	#0,#32,4(sp),r1
	addl2	r1,(sp)
	popl	r1
	popl	r0
	rsb
;
; setsoftl -
; Called with R11 = LDT, r5=orig channel UCB, r6=CCB
; If softlink needed, should set ccb$l_ucb to desired UCB
; or else let it alone.
setsoftl: .jsb_entry
	pushr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	cmpl	ldt$l_ace+8(r11),acllit	;this our ACE?
	bneqw	999$
	movab	ldt$l_ace(r11),r10	;point at the ACE now
	movab	12(r10),r10	;start of data
1$:	movzbl	(r10)+,r9	;get fcn byte
	beqlw	999$
	cmpb	r9,#1		;inspectme => not here
	beql	1$
	cmpb	r9,#2		;moveme
	beql	1$
	cmpb	r9,#3		;base prio set?
	bneq	2$		;if not look more
; set base prio if ok
	cvtbl	(r10)+,r8	;prio to use to r8
	movl	(r10)+,r7	;one long of sec.info
	brw	1$
2$:
	cmpb	r9,#4		;priv set?
	bneq	3$		;if neq look more
	movl	(r10)+,r0	;sec info
	movl	(r10)+,r1	;sec info
	movl	(r10)+,r2	;get info from ace
	movl	(r10)+,r3
	brw	1$
3$:	cmpb	r9,#5		;ident set?
	bneq	4$
	movl	(r10)+,r0	;sec info
	movl	(r10)+,r1	;sec info
	movl	(r10)+,r2	;get info from ace
	movl	(r10)+,r3
	brw	1$
4$:	cmpb	r9,#6		;softlink record?
	bneqw	5$		;skip out if illegal value
	movzbl	(r10),r9	;get length of data
; Softlink file. Find file & device and deal with it.
; Note: not looking at flags yet here. Just links files.
; (this is ok for a security tool. Directory links etc. not
;  yet dealt with.)
; get file ID first
	movl	r10,r8		;point at data
	addl2	r9,r10		;add to pointer used globally in this sub
; see if we should skip softlink recognition for this process.
; ldt$l_reg+8 is r4 which is a pcb pointer
	.if	df,pcbmsk$$
	movl	g^ctl$gl_pcb,r4	;get curr. pcb for sure
; if reserved shelving bit is clear we work as usual
	bbc	#pcb$v_shelving_reserved,pcb$l_sts2(r4),502$
; if and only if the nounshelve bit is clear, just skip softlinks
	bbc	#pcb$v_nounshelve,pcb$l_sts2(r4),1502$
502$:
	.endc
	incl	r8		;pass length byte
	movl	r8,r9		;use r9 as a base reg later
	addl2	#<1+4+2>,r8	;pass flags, file id
; check & act on flags
	tstb	(r9)		;normal link (0)?
	beql	901$
	cmpb	#1,(r9)		;r/o link?
	bneq	901$		;no. Presume dir. link must work normally.
	bitl	#fib$m_write,ldt$l_accmd(r11)	;r/o open (write bit clr?)
	beql	901$		;yes, do write link
1502$:	brw	1$		;else don't do link. Daemon must coop too.
901$:
	incl	ldt$l_softf(r11)	;flag we did have a softlink
; at r9, have <flags byte><file-id-6 bytes>
;next we get device name (counted ascii in ace)
	movl	g^ctl$gl_pcb,r4	;get curr. pcb for sure
	jsb	g^sch$iolockw	;lock mutex
;build name descr. on stack
	subl2	#12,sp		;get space
	movl	sp,r2		;& pointer
	movzbw	(r8)+,(r2)	;size of string
	movb	#dsc$k_dtype_t,2(r2)
	movb	#1,3(r2)	;fixed string
	movl	r8,4(r2)	;data address
	movl	r2,r1		; string addr in r1 needed
	pushr	#^m<r3,r4,r5,r8,r9>
	jsb	g^ioc$searchdev	;find device
	popr	#^m<r3,r4,r5,r8,r9>
	addl2	#12,sp		;put stack back
	blbc	r0,7$		;if can't find, skip it
; Looks ok. Now reset ref counts on the UCBs and fix up
; user FIB ref to new file and CCB UCB ref.
	movl	ccb$l_ucb(r6),r7	;old ucb
	.if	df,evax
	decl	ucb$l_refc(r7)		;count his refs down
	bgtr	10$
	clrl	ucb$l_refc(r7)
	.iff
	decw	ucb$w_refc(r7)		;count his refs down
	bgtr	10$
	clrw	ucb$w_refc(r7)
	.endc
10$:	movl	r1,ccb$l_ucb(r6)	;update user CCB
	.if	df,evax
	incl	ucb$l_refc(r1)		;& count 1 ref up there
	.iff
	incw	ucb$w_refc(r1)		;& count 1 ref up there
	.endc
	evax_ldq r3,ldt$l_regs+8(r11)
;	movl	ldt$l_regs+8(r11),r3	;get user IRP
	movl	r1,irp$l_ucb(r3)	;point that at this ucb
;update FIB pointer now.
	movl	ldt$l_parm(r11),r8	;get P1 = fib descr.
	beql	7$
	movl	4(r8),r8		;get fib addr to r8 here
	beql	7$
	movl	1(r9),fib$w_fid(r8)	;fill in file id
	movw	5(r9),fib$w_fid+4(r8)	;all 6 bytes
	clrw	fib$w_did(r8)
	clrl	fib$w_did+2(r8)	;set no lookup on softlinks...we have a file id
	bicw	#fib$m_findfid,fib$w_nmctl(r8)	;no fid or wild lookup
	bicw	#fib$m_wild,fib$w_nmctl(r8)
	clrl	fib$l_wcc(r8)		;no wild context
7$:	jsb	g^sch$iounlock
	brw	1$
5$:	cmpb	r9,#7		;temp tag?
	bneq	999$		;if ill value scram
	movzbl	(r10),r9	;get length
	addl2	r9,r10
	brw	1$
999$:
	popr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	rsb
;
; movldt -
; Called with R11 = LDT entry, ccb$l_ucb(r6) = new UCB, 
; ldt$chnucb = old UCB = r5. This routine should relink the
; LDT from the old device to the new one.
movldt: .jsb_entry
	pushr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
; first find pointer to the old LDT
	movl	g^ctl$gl_pcb,r4
	devicelock lockaddr=ucb$l_dlck(r5), -
	 lockipl=ucb$b_dipl(r5),preserve=YES
	pushl	r5
	jsb	findldt		;get existing LDT
	tstl	r0
	beql	999$
	movl	r1,r10		;old pointer in r10 now
	movl	ldt$l_fwd(r11),ldt$l_fwd(r10)	;remove LDT from this chain
; now find new place for the LDT
	movl	ccb$l_ucb(r6),r5	;UCB we need to go to
	jsb	findldt		;find where we can put ldt
	tstl	r0	;r0 better be 0
	beql	2$
; If this is the LAST LDT, just to be safe, clear paranoid mode.
; r5 is jt ucb now, R11 is LDT address
	jsb	chklast			;check for last LDT
	movl	ldt$l_fresiz(r11),r1
	movl	r11,r0
	jsb	g^exe$deanonpgdsiz
	brb	999$
2$:	clrl	ldt$l_fwd(r11)		;set no fwd from us
	movl	r11,ldt$l_fwd(r1)	;point other chain at us
999$:
	popl	r5
	deviceunlock lockaddr=ucb$l_dlck(r5),newipl=#ipl$_astdel,preserve=YES
	popr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	rsb
;
; dowait. Enter with r10 = iosb block and r11 = ldt
; bashes r0
;
dowait: .jsb_entry output=<r0,r10>
	setipl ipl=#0,environ=UNIPROCESSOR
10$:	tstl	(r10)		;iosb nonzero already?
	bneq	90$
	movl	ldt$l_prcstr(r11),r0	;point at process string
	bgeq	90$			;invalid -> exit
	tstl	(r0)		;knl threads all done?
; all knl threads done means finished
	beql	90$		;if so scram.
;looks like we need to wait. Do so.
	movl	#31,-(sp)	;wait for efn 31
	calls	#1,g^sys$waitfr
; then clear it again
	movl	#31,-(sp)
	calls	#1,g^sys$clref
	brb	10$		;then check again
90$:	movl	r10,r0		;save data address
	movl	(r10),r10	;get status finally, return in r10
	bneq	92$		;if nonzero that's good
	movl	#2,r10		;else force nonzero but bogus
92$:	pushr	#^m<r0,r1,r2,r3>
; deallocate the "iosb" block from pool now.
	movl	#16,r1		;16 bytes
	jsb	g^exe$deanonpgdsiz
	popr	#^m<r0,r1,r2,r3>	
	rsb
; done now.
; fdt redo entries.
; Logic pretty much copied from sysqioreq.mar bit
	.entry fdtlop,^m<r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
10$:	addl2	#12,r8	;next mask
	bbc	r7,(r8),10$
	movl	8(r8),r0	;get address
	jsb	(r0)
	brb	10$
	.entry fdtxit,^m<r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	movl	#ss$_normal,r0	;good fake exit
	jsb	x$fini
	ret
	.entry fdtbxt,^m<r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	movl	#ss$_drverr,r0	;bad fakeexit. no priv...the classic VMS status
	jsb	x$fini
	ret		;for appearances sake

x$fini:	.jsb_entry
	call_finishioc do_ret=no
	rsb

DeacFilt: $driver_fdt_entry
	pushr	#^m<r0,r5>
; original r5 now at 4(sp). Must get that to continue the ops.
	jsb	getJTucb		;find JTdriver ucb
	tstl	r0
	blss	509$
1509$:	popr	#^m<r0,r5>
	bsbw	popout
	ret
509$:
;	bgeqw	popout
	movl	r5,ucb$l_backlk(r0)	;save link'd ucb in ours too.
	movl	r0,r5			;point R5 at JT UCB
	bitl	#65792,ucb$l_ctlflgs(r5)	;look at deaccess (close)?
	beqlw	1509$			; if eql no, forget it
; Make sure this isn't one of OUR daemons
	cmpl	pcb$l_pid(r4),ucb$l_daemon(r5)	;open etc. daemon?
	beqlw	1509$
	cmpl	pcb$l_pid(r4),ucb$l_exdmn(r5)	;not extend daemon
	beqlw	1509$
	cmpl	pcb$l_pid(r4),ucb$l_deldmn(r5)
	beqlw	1509$			;not delete daemon
	cmpl	pcb$l_pid(r4),ucb$l_exempt(r5)	;exempted pid?
	beqlw	1509$
	cmpl	pcb$l_pid(r4),ucb$l_exempt+4(r5) ;exempted pid?
	beqlw	1509$
	cmpl	pcb$l_pid(r4),ucb$l_exempt+8(r5) ;exempted pid?
	beqlw	1509$
	cmpl	pcb$l_pid(r4),ucb$l_exempt+12(r5) ;exempted pid?
	beqlw	1509$
;make sure not a knl mode channel (leave the XQP channel alone!!!)
	cmpb	ccb$b_amod(r6),#1	;this the XQP's chnl?
	bleqw	1509$			; if so scram NOW.
; Looks like we need to inspect this entry.
; If there's a softlink, pass the FDT calls for the user, then
; restore the channel, remove LDT, etc.
	movl	r5,r10			;pass orig. UCB addr in R10
; change it to orig. one in clenup if we need to reissue i/o &
; then reset chnl.
	jsb	clnup			;go restore privs/prio/idents etc.
	cmpl	r10,r5			;need to reset chnl?
	beql	99$			;if eql no, just exit
	pushl	r10			;need to remember desired UCB addr
; reissue rest of fdts
	pushl	r5			;keep JT ucb around
	movl	ucb$l_backlk(r5),r5	;victim ucb
	subl2	#24,sp			;make stack room
	movl	sp,r9
	.if	df,evax
	movl	irp$l_qio_p1(r3),(r9)
	movl	irp$l_qio_p2(r3),04(r9)
	movl	irp$l_qio_p3(r3),08(r9)
	movl	irp$l_qio_p4(r3),12(r9)
	movl	irp$l_qio_p5(r3),16(r9)
	movl	irp$l_qio_p6(r3),20(r9)
	.iff
	movl	p1(ap),(r9)
	movl	p2(ap),04(r9)
	movl	p3(ap),08(r9)
	movl	p4(ap),12(r9)
	movl	p5(ap),16(r9)
	movl	p6(ap),20(r9)
	.endc
; reconstitute call to victim's FDT
        EXTZV   #IRP$V_FCODE,#IRP$S_FCODE,IRP$L_FUNC(R3),R1     ; GET FCN CODE
	pushr	#^m<r6,r7,r8,r9>
	jsb	getjtucb		;locate JT UCB
	tstl	r0
	bgeq	199$			;no JT UCB should not happen
	movab	ucb$l_oldfdt(r0),r7
	bgeq	199$		;if old FDT isn't in sys space we're messed
; Here rely on the fact that we got here via our modified FDT call and that
; the orig. FDT is stored just a bit past the current one.
; ucb$l_oldfdt near ucb$l_myfdt
	addl2	#8,r7			;point at one of 64 fdt addresses
	movl	(r7)[r1],r8		;r7 is desired routine address
;now call the "official" FDT code
	pushl	r6	;ccb
	pushl	r5	;ucb
	pushl	r4	;pcb
	pushl	r3	;irp
	calls	#4,(r8)			;Call the original routine
	popr	#^m<r6,r7,r8,r9>
	brb	1199$
199$:
	popr	#^m<r6,r7,r8,r9>
	movl	#16,r0			;fail with err if structures messed
	call_finishioc do_ret=yes
1199$:
; Now return as the original routine would.
;	callg	(r9),fdtlop		;reissue fdt chain
	setipl ipl=#2,environ=UNIPROCESSOR
	addl2	#24,sp		; fix stack
	popl	r5
	popl	r10
	movl	ccb$l_ucb(r6),r9	;keep old ucb a mo...
	movl	r10,ccb$l_ucb(r6)	;reset user channel to orig. device
; adjust ref counts now
	.if	df,evax
	decl	ucb$l_refc(r9)		;1 less chnl on old dvc
	bgtr	4$			;if 1+, ok
	movl	#1,ucb$l_refc(r9)	;mounted dsk should have 1 or more
4$:	incl	ucb$l_refc(r10)		;bump new count again
	.iff
	decw	ucb$w_refc(r9)		;1 less chnl on old dvc
	bgtr	4$			;if 1+, ok
	movw	#1,ucb$w_refc(r9)	;mounted dsk should have 1 or more
4$:	incw	ucb$w_refc(r10)		;bump new count again
	.endc
;;;??????  check flow here
	popr	#^m<r0,r5>
;	setipl ipl=#0,environ=UNIPROCESSOR
	movl	#ss$_fdt_compl,r0
	ret
99$:
	popr	#^m<r0,r5>
	bsbw	popout
	ret
;	rsb
clnup: .jsb_entry output=<r10>
; remove old ldt etc. after prio/priv/ident restore. If
; original UCB in LDT differs from UCB now, save orig ucb in R10
	pushr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r11>
; find LDT first. If none, not much to do.
	jsb	findldt
	tstl	r0		;got an ldt?
	beqlw	999$		;if eql no
	movl	r0,r11		;ldt in r0 if nonzero
;put prio/privs back
	movl	g^ctl$gl_pcb,r4
	.if	df,evax
	movl	ldt$l_bprio(r11),pcb$l_prib(r4)
	.iff
	movb	ldt$l_bprio(r11),pcb$b_prib(r4)
	.endc
; Decrement opnchk flags etc. in prc structure since this file is being
; closed and has an ldt, if flagged.
	pushl	r10
	bbcc	#ldt$v_opnchk,ldt$l_accmd(r11),3503$
; opnchk was set.
	movl	ldt$l_prcstr(r11),r10	;get proc struct
	bgeq	3503$			;paranoia
	decl	<<6-2>*4>(r10)		;count opnchk down
	bgeq	3503$
	clrl	<<6-2>*4>(r10)		;clamp it positive
3503$:
	bbcc	#ldt$v_runfcn,ldt$l_accmd(r11),4503$
	movl	ldt$l_prcstr(r11),r10	;get proc struct
	bgeq	4503$			;paranoia
	decl	<<7-2>*4>(r10)		;count down runfcn
	bgeq	4503$
	clrl	<<7-2>*4>(r10)		;clamp positive
4503$:
	popl	r10
	movl	ldt$l_wprv(r11),pcb$q_priv(r4)
	movl	ldt$l_wprv+4(r11),pcb$q_priv+4(r4)
	movl	ldt$l_wprv(r11),g^ctl$gq_procpriv
	movl	ldt$l_wprv+4(r11),g^ctl$gq_procpriv+4
	movl	g^ctl$gl_phd,r4
	movl	ldt$l_aprv(r11),phd$q_authpriv(r4)
	movl	ldt$l_aprv+4(r11),phd$q_authpriv+4(r4)
	movl	ldt$l_wprv(r11),phd$q_privmsk(r4)
	movl	ldt$l_wprv+4(r11),phd$q_privmsk+4(r4)
	.if	df,pcb$ar_natural_psb_def
; Allow mods of PSB based privs etc. if it exists.
; Get data from the PSB if it exists.
	pushl	r9
	pushl	r4
	movl	g^ctl$gl_pcb,r4
	movl	pcb$ar_natural_psb(r4),r9	; point at the PSB block
	movl	ldt$l_aprv(r11),psb$q_authpriv(r9)
	movl	ldt$l_aprv+4(r11),psb$q_authpriv+4(r9)
	movl	ldt$l_wprv(r11),psb$q_permpriv(r9)
	movl	ldt$l_wprv+4(r11),psb$q_permpriv+4(r9)
	popl	r4
	popl	r9
	.endc
; See if this is closing a softlink that changed devices
; so the user channel needs to be put back.
	cmpl	ldt$l_chnucb(r11),ccb$l_ucb(r6)	;softlink close?
	beql	1$		;if eql no
	movl	ldt$l_chnucb(r11),r10	;else save orig. ucb
1$:
; put back idents
	pushl	r10
	jsb	undoid		;undo ident hacking. Do this in a subroutine
				;for clarity. We need to again root thru the
				;ACE to accomplish this...
	popl	r10
; get rid of whole LDT
; clean all out
; Synch: LDT pertains to this process only, so should be no problem
; with other LDTs. The LDT vector is per-process.
	jsb	findldt		;find where this LDT is
; On return r1 is previous LDT (which we need) and r0 is
; LDT address (must be same as R11).
	cmpl	r0,r11
	bneq	999$		;if we get bad LDT, don't mess
; Use careful order so nothing else gets interfered with.
; r1 is prev LDT, r11 is this one.
	movl	ldt$l_fwd(r11),ldt$l_fwd(r1)	;collapse this LDT out of chain
; If this is the LAST LDT, just to be safe, clear paranoid mode.
; r5 is jt ucb now, R11 is LDT address
	jsb	chklast			;check for last LDT
;now deallocate this LDT & go
	movl	ldt$l_fresiz(r11),r1		;length to free
	movl	r11,r0			;addr to free
	jsb	g^exe$deanonpgdsiz	;free it
; Now the LDT is freed and we go off on our merry way. The file gets closed
; by later FDT stuff.
999$:
	popr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r11>
	rsb
;;
clnupnd: .jsb_entry output=<r10>
;  prio/priv/ident restore. If
; original UCB in LDT differs from UCB now, save orig ucb in R10
	pushr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r11>
; find LDT first. If none, not much to do.
	jsb	findldt
	tstl	r0		;got an ldt?
	beqlw	999$		;if eql no
	movl	r0,r11		;ldt in r0 if nonzero
;put prio/privs back
	movl	g^ctl$gl_pcb,r4
	.if	df,evax
	movl	ldt$l_bprio(r11),pcb$l_prib(r4)
	.iff
	movb	ldt$l_bprio(r11),pcb$b_prib(r4)
	.endc
	movl	ldt$l_wprv(r11),pcb$q_priv(r4)
	movl	ldt$l_wprv+4(r11),pcb$q_priv+4(r4)
	movl	ldt$l_wprv(r11),g^ctl$gq_procpriv
	movl	ldt$l_wprv+4(r11),g^ctl$gq_procpriv+4
	movl	g^ctl$gl_phd,r4
	movl	ldt$l_aprv(r11),phd$q_authpriv(r4)
	movl	ldt$l_aprv+4(r11),phd$q_authpriv+4(r4)
	movl	ldt$l_wprv(r11),phd$q_privmsk(r4)
	movl	ldt$l_wprv+4(r11),phd$q_privmsk+4(r4)
	.if	df,pcb$ar_natural_psb_def
; Allow mods of PSB based privs etc. if it exists.
; Get data from the PSB if it exists.
	pushl	r9
	pushl	r4
	movl	g^ctl$gl_pcb,r4
	movl	pcb$ar_natural_psb(r4),r9	; point at the PSB block
	movl	ldt$l_aprv(r11),psb$q_authpriv(r9)
	movl	ldt$l_aprv+4(r11),psb$q_authpriv+4(r9)
	movl	ldt$l_wprv(r11),psb$q_permpriv(r9)
	movl	ldt$l_wprv+4(r11),psb$q_permpriv+4(r9)
	popl	r4
	popl	r9
	.endc
; See if this is closing a softlink that changed devices
; so the user channel needs to be put back.
	cmpl	ldt$l_chnucb(r11),ccb$l_ucb(r6)	;softlink close?
	beql	1$		;if eql no
	movl	ldt$l_chnucb(r11),r10	;else save orig. ucb
1$:
; put back idents
	pushl	r10
	jsb	undoid		;undo ident hacking. Do this in a subroutine
				;for clarity. We need to again root thru the
				;ACE to accomplish this...
	popl	r10
; get rid of whole LDT AFTER dowait only...not here!!!
; clean all out
999$:
	popr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r11>
	rsb

; Revoke identifiers found granted by the ACE.
undoid: .jsb_entry
	pushr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	movab	ldt$l_ace(r11),r10	;point at our ACE
; look for priv sets
	cmpl	ldt$l_ace+8(r11),acllit	;this our ACE?
	bneqw	999$
	movab	12(r10),r10	;start of data
1$:	movzbl	(r10)+,r9	;get fcn byte
	beqlw	999$
	cmpb	r9,#1		;inspectme => not here
	beql	1$
	cmpb	r9,#2		;moveme
	beql	1$
	cmpb	r9,#3		;base prio set?
	bneq	2$		;if not look more
; set base prio if ok
	cvtbl	(r10)+,r8	;prio to use to r8
	movl	(r10)+,r7	;one long of sec.info
	brw	1$
2$:
	cmpb	r9,#4		;priv set?
	bneq	3$		;if neq look more
	movl	(r10)+,r0	;sec info
	movl	(r10)+,r1	;sec info
	movl	(r10)+,r2	;get info from ace
	movl	(r10)+,r3
	brw	1$
3$:	cmpb	r9,#5		;ident set?
	bneq	4$
; If the auth check passed first time, it'll pass now, so check
; just as was done to grant, and revoke anything we would have granted
; initially.
	movl	(r10)+,r0	;sec info
	movl	r0,r7
	movl	(r10)+,r1	;sec info
	movl	r0,r8
	movl	ldt$l_myfid(r11),r2	;file id
	movl	ldt$l_myfid+4(r11),r3	;hi fileid
; At file close time we may have blown file ID away off end of LDT
; so don't authorize...just check for null identifier and don't revoke
; that...
;	jsb	auth
	movl	(r10)+,r2	;get info from ace
	movl	(r10)+,r3
;	cmpl	r0,r2		;check auth info
;	bneq	4$
;	cmpl	r1,r3
;	bneq	4$
	tstl	r7		;null identifier (1st long =0)?
	beql	4$		;if so we didn't auth it on grant...no revoke
; UNgrant identifier in r7,r8 to curr. process.
	clrq	-(sp)		;clear privatr & procname cells
	movab	-16(r10),-(sp)	;addr of identifier info
	clrq	-(sp)		;null pid & prcname
	calls	#5,revokid	;use internal code (from vms)
	brw	1$
4$:	cmpb	r9,#6		;softlink record?
	bneq	5$		;skip out if illegal value
	movzbl	(r10),r9	;get length of data
	addl2	r9,r10		;add to pointer
	brw	1$
5$:	cmpb	r9,#7		;temp tag?
	bneq	999$		;if ill value scram
	movzbl	(r10),r9	;get length
	addl2	r9,r10
	brw	1$
999$:
	popr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	rsb
;
; Delfilt =
; Monitor delete requests; allow a daemon to "do something" first (like
; make a copy for awhile)
DelFilt: $driver_fdt_entry
; be sure not a knl channel
	tstl	r6		;is there a CCB (must be +)
	bleq	2$		;if not skip out
	cmpb	ccb$b_amod(r6),#1	;knl mode access?
	bgtr	1$
2$:	bsbw	pors		;leave knl channelsalone, continue chain
	ret
1$:
; filter only if io$m_delete set
        .if     ndf,evax
        bitw    #io$m_delete,irp$w_func(r3)     ;is he really deleting?
        .iff
        bitl    #io$m_delete,irp$l_func(r3)     ;is he really deleting?
        .endc
        beql    2$              ;no, just rename...branch
; If both pcb$m_nounshelve and pcb$m_shelving_Reserved bits are
; set in PCB, omit the filtering.
	.if	df,pcbmsk$$
; if reserved shelving bit is clear we filter as usual
	bbc	#pcb$v_shelving_reserved,pcb$l_sts2(r4),502$
; if and only if both bits are set we skip out
	bbs	#pcb$v_nounshelve,pcb$l_sts2(r4),2$
502$:
	.endc
; Do deletion control stuff
	pushr	#^m<r0,r5>
; original r5 now at 4(sp). Must get that to continue the ops.
	jsb	getJTucb		;find JTdriver ucb
	tstl	r0
	blss	509$
1509$:	popr	#^m<r0,r5>
	bsbw	popout
	ret
509$:
;	bgeqw	popout
	movl	r5,ucb$l_backlk(r0)	;save link'd ucb in ours too.
	movl	r0,r5			;point R5 at JT UCB
; Want this control?
	bitl	#<128>,ucb$l_ctlflgs(r5)	;user want delete control?
	beqlw	1509$			;if eql no, skip out.
; Make sure this isn't one of OUR daemons
	cmpl	pcb$l_pid(r4),ucb$l_daemon(r5)	;open etc. daemon?
	beqlw	1509$
	cmpl	pcb$l_pid(r4),ucb$l_exdmn(r5)	;not extend daemon
	beqlw	1509$
	cmpl	pcb$l_pid(r4),ucb$l_deldmn(r5)
	beqlw	1509$			;not delete daemon
	cmpl	pcb$l_pid(r4),ucb$l_exempt(r5)	;exempted pid?
	beqlw	1509$
	cmpl	pcb$l_pid(r4),ucb$l_exempt+4(r5) ;exempted pid?
	beqlw	1509$
	cmpl	pcb$l_pid(r4),ucb$l_exempt+8(r5) ;exempted pid?
	beqlw	1509$
	cmpl	pcb$l_pid(r4),ucb$l_exempt+12(r5) ;exempted pid?
	beqlw	1509$
;make sure not a knl mode channel (leave the XQP channel alone!!!)
	cmpb	ccb$b_amod(r6),#1	;this the XQP's chnl?
	bleqw	1509$			; if so scram NOW.
	tstl	ccb$l_wind(r6)		;if a window exists, open now
	beql	191$			;if not open branch, no need for
					;softlink test.
	bitl	#<1>,ucb$l_ctlflgs(r5)	;user want open control?
	beql	191$			;if not, no LDT to find will exist
; there COULD be an LDT and a softlink so don't allow deletes to open
; softlinks to delete the linked file.
; ********** new hack ****************
; ***** ctlflgs 80000 (hex) bit allows del of softlinked files ********
	bitl	#^x80000,ucb$l_ctlflgs(r5)	;give way to shut this off
	bneq	191$				;if ctlflgs has 80000 hex bit
	pushr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r11>
; find LDT first. If none, not much to do.
	jsb	findldt
	tstl	r0		;got an ldt?
	beql	192$		;if eql no
	pushl	r10
	bbcc	#ldt$v_opnchk,ldt$l_accmd(r0),3503$
; opnchk was set.
	movl	ldt$l_prcstr(r0),r10	;get proc struct
	bgeq	3503$			;paranoia
	decl	<<6-2>*4>(r10)		;count opnchk down
	bgeq	3503$
	clrl	<<6-2>*4>(r10)		;clamp it positive
3503$:
	bbcc	#ldt$v_runfcn,ldt$l_accmd(r0),4503$
	movl	ldt$l_prcstr(r0),r10	;get proc struct
	bgeq	4503$			;paranoia
	decl	<<7-2>*4>(r10)		;count down runfcn
	bgeq	4503$
	clrl	<<7-2>*4>(r10)		;clamp positive
4503$:
	popl	r10
	tstl	ldt$l_softf(r0)	;was there a softlink?
	beql	192$		;if not skip
; must prevent the deletion by faking success.
	popr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r11>
	pushl	r0
	brw	2999$		;so fake success deleting the file.
192$:
	popr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r11>
191$:
; Want this control?
	bitl	#<128>,ucb$l_ctlflgs(r5)	;user want delete control?
	beqlw	1509$			;if eql no, skip out.
; Also...hack...
;if io$m_create is seen here (128 bit) we erase it from the
; irp but skip this i/o, to allow utils to do more work.
; This is because we probably will want other utilities to
; do deletions and need not to force them to be all within the
; daemon process.
	.if	df,evax
	bitL	#io$m_create,irp$l_func(r3)	;bogus subfunc?
	beql	10$			;if not there, normal
	bicl	#io$m_create,irp$l_func(r3)	;else remove and
	.iff
	bitw	#io$m_create,irp$w_func(r3)	;bogus subfunc?
	beql	10$			;if not there, normal
	bicw	#io$m_create,irp$w_func(r3)	;else remove and
	.endc
	brw	999$			;let delete by
10$:
; Now ensure that this call is not in the same JOB as the daemon.
; (This lets the daemon spawn processes to do some work.)
	pushr	#^m<r6,r7,r8,r9,r10,r11>	;get some regs
	movl	ucb$l_deldmn(r5),r10	;get the daemon PID
	bleq	5$
	movzwl	r10,r7			;get process index
; like code in FQdriver...
	movl	 g^sch$gl_pcbvec,r6	;get pcb vector
	movl	(r6)[r7],r8		;get a PCB address
	tstl	r8			;ensure a system addr
	bgeq	5$			;skip if not
	cmpl	r10,pcb$l_pid(r8)	;be sure this is the daemon process
	bneq	5$			;else skip
; ok, we for sure have the daemon's PCB now. See if the JIBs match
	cmpl	pcb$l_jib(r8),pcb$l_jib(r4)	;same JIB as daemon's?
	bneq	5$			;if not, don't skip out
	popr	#^m<r6,r7,r8,r9,r10,r11>	;get regs back now
48$:	brw	1509$			;then buzz off
5$:
	popr	#^m<r6,r7,r8,r9,r10,r11>	;get regs back now
; Notify deldmn if one exists. Let that do the real work.
; Looks like we CAN help, if there's someone out there we can yell for.
; Check this.
	pushl	r0
	pushl	r10
	pushl	r11
	.if	ndf,evax
	movl	p1(ap),r0	;get fib
	.iff
	movl	irp$l_qio_p1(r3),r0
	.endc
	ifnord #4,4(r0),51$
	movl	4(r0),r0	;...from descriptor
	movl	r0,r9			;save user FIB address
	clrl	r11			;r11=0 ==> flag no security interest
	pushr	#^m<r0,r1,r2,r3>	;need some regs
	.if	df,evax
	movl	irp$l_qio_p1(r3),r0	;get FIB desc
	.iff
	movl	p1(ap),r0
	.endc
	beql	450$
	movl	4(r0),r0		;get fib addr
	beql	450$
	movzwl	fib$w_fid(r0),r1	;get file number (check numbers
					; to save space)
	movl	#f.nums,r2		; get size of store
	.if	df,wd.lst
	movab	ucb$l_fnums(r5),r3	; point at store
49$:	cmpw	(r3)+,r1		; same file number?
	beql	47$			; if so go ahead
	sobgtr	r2,49$
	.iff	;bitmap
; r1 is file number...
	movl	ucb$l_fnums(r5),r3	; addr of storage
	beql	47$			; if none pretend everything matches
	.iif	ndf,f.mask,f.mask=-16384 ;max bits to use in bitmap check
	bicl	#f.mask,r1		;clear extra bits
	ashl	#-3,r1,r2		;r2 gets byte offset into bitmap
	addl3	r3,r2,r0		;get address
	bicl	#-8,r1			;isolate bit in byte now (0-7)
	bbs	r1,(r0),47$		;if the bit is zero, not here
					;if the bit is set, though, go fer it
	.endc
; fall thru...no match
450$:	popr	#^m<r0,r1,r2,r3>
	brb	51$
47$:
	popr	#^m<r0,r1,r2,r3>
	incl	r11			; flag to check del access
50$:
; (r0 is too volatile)
51$:
	movl	ucb$l_delmbx(r5),r10	;get del mbx ucb if any
	bgeq	850$			;if none, can'thelp.
	bitl	#ucb$m_online,ucb$l_sts(r10)	;online?
	beql	850$			;if not no soap
	.if	df,evax
	tstl	ucb$l_refc(r10)		;anyone listening?
	.iff
	tstw	ucb$w_refc(r10)		;anyone listening?
	.endc
	beql	850$			;if no, no dmn.
	tstl	ucb$l_orb(r10)		;owner exist?
	bgeq	850$			;if geq no, skip.
; check pid now for delpid
	pushr	#^m<r5,r6,r7,r8>
	movl	g^sch$gl_maxpix,r7	;max proc index
100$:	movl	g^sch$gl_pcbvec,r6	;pcb vector
	movl	(r6)[r7],r8	;get a pcb
	tstl	r8		;got one?
	bgeq	101$		;if geq no
	cmpl	ucb$l_deldmn(r5),pcb$l_pid(r8) ;this our pid?
	beql	102$		;if eql yes, all well
101$:	sobgtr	r7,100$		;check 'em all
	clrl	ucb$l_deldmn(r5) ;clr dmn pid if it isn'tthere now
102$:	popr	#^m<r5,r6,r7,r8>
	tstl	ucb$l_deldmn(r5) ;is the daemon around?
	beql	850$		;if not skip out
; Looks like a msg can besent, so do so. For clarity do in a sub.
	pushr	#^m<r3,r4,r5,r6,r7,r8>
	jsb	snddelmsg	;send delete message
	popr	#^m<r3,r4,r5,r6,r7,r8>
; note secret return code 4096 indicates failure.
850$:
800$:
	popl	r11
	popl	r10
	cmpl	#3,r0		;fake success status?
	beql	2999$
	blbc	r0,1999$
	popl	r0

999$:	brw	1509$
;	popr	#^m<r0,r5>
;	movl	#1,r0
;	rsb
1999$:	popl	r0		;restore the stack
	popr	#^m<r0,r5>
	movl	#ss$_drverr,r0	;return no priv if daemon rejected the op
	call_abortio
;	ret
;	jmp	g^exe$abortio	;and abort the i/o
2999$:	popl	r0
	.if	df,zotdi$
; ensure if faking success that dir id looks empty so we get no msg
	.if	ndf,evax
	movl	p1(ap),r0	;get fib
	.iff
	movl	irp$l_qio_p1(r3),r0
	.endc
	ifnord #4,4(r0),2951$
	movl	4(r0),r0	;...from descriptor
	beql	2951$		;fib addr can't be 0
	clrl	fib$w_did(r0)	;clear dir id
	clrw	fib$w_did+4(r0)	;(6 bytes)
	.endc
2951$:	popr	#^m<r0,r5>
	movl	#1,r0
	call_finishioc do_ret=yes
;	rsb
;
; Crefilt - 
; Get create requests for purposes of doing space management.
; Needed also for cases where directory is a bogus one we put in
; to do directory softlinks; must then change device & did to a
; real one somewhere.
; We will pass the entire FIB to the server daemon process here
; and arrange that the FIB status fields can be returned also.
; This will permit the daemon to create the file on our behalf and
; pass status back.
Crefilt: $driver_fdt_entry
; be sure not a knl channel
	tstl	r6		;is there a CCB (must be +)
	bleq	2$		;if not skip out
	cmpb	ccb$b_amod(r6),#1	;knl mode access?
	bgtr	1$
2$:	bsbw pors	;leave knl mode chnls alone!
	ret
1$:
; If both pcb$m_nounshelve and pcb$m_shelving_Reserved bits are
; set in PCB, omit the filtering.
	.if	df,pcbmsk$$
; if reserved shelving bit is clear we filter as usual
	bbc	#pcb$v_shelving_reserved,pcb$l_sts2(r4),502$
; if and only if both bits are set we skip out
	bbs	#pcb$v_nounshelve,pcb$l_sts2(r4),2$
502$:
	.endc
	pushr	#^m<r0,r5>
; original r5 now at 4(sp). Must get that to continue the ops.
	jsb	getJTucb		;find JTdriver ucb
	tstl	r0
	blss	509$
1509$:
	popr	#^m<r0,r5>
	bsbw	popout
	ret
509$:
;	bgeqw	popout
	movl	r5,ucb$l_backlk(r0)	;save link'd ucb in ours too.
	movl	r0,r5			;point R5 at JT UCB
	bitl	#16,ucb$l_ctlflgs(r5)	;look at create?
	beqlw	1509$			;if not skip
; Make sure this isn't one of OUR daemons
	cmpl	pcb$l_pid(r4),ucb$l_daemon(r5)	;open etc. daemon?
	beqlw	1509$
	cmpl	pcb$l_pid(r4),ucb$l_exdmn(r5)	;not extend daemon
	beqlw	1509$
	cmpl	pcb$l_pid(r4),ucb$l_deldmn(r5)
	beqlw	1509$			;not delete daemon
	cmpl	pcb$l_pid(r4),ucb$l_exempt(r5)	;exempted pid?
	beqlw	1509$
	cmpl	pcb$l_pid(r4),ucb$l_exempt+4(r5) ;exempted pid?
	beqlw	1509$
	cmpl	pcb$l_pid(r4),ucb$l_exempt+8(r5) ;exempted pid?
	beqlw	1509$
	cmpl	pcb$l_pid(r4),ucb$l_exempt+12(r5) ;exempted pid?
	beqlw	1509$
;make sure not a knl mode channel (leave the XQP channel alone!!!)
	cmpb	ccb$b_amod(r6),#1	;this the XQP's chnl?
	bleqw	1509$			; if so scram NOW.

;
; Add the ability to fake create functions in a daemon.
; Do so if the ^x80000 bit is set in ctlflgs AND if the process' PID
; is set in the process structure indicating this process is interested
; in NT emulation.
; Only do this if io$m_create set and io$m_delete NOT set
	bitl	#io$m_create,irp$l_func(r3)	;check he wants to really crea.
	beql	4$				;if not no check
	bitl	#io$m_delete,irp$l_func(r3)	;temp file?
	bneq	4$				;if so also no check
	bitl	#^x100000,ucb$l_ctlflgs(r5)	;want dir treatment for r/o?
	beql	4$			;if eql no
	bitl	#^x200000,ucb$l_ctlflgs(r5)	;require proc struct test?
	beql	5$			;if neq yes
; look in process struct to see if we need to send msg
	movl	ucb$l_prcvec(r5),r10;start of ldt chain
	bgeq	4$		;lose if none
	movzwl	pcb$l_pid(r4),r1	;get index
	ashl	#5,r1,r1		;get tbl entry offset
; shift 5 so 32 bytes = 8 longs per entry
	addl2	r1,r0			;point at our syruct
	addl2	#pv.pid,r0		;point at our pid
	cmpl	(r0),pcb$l_pid(r4)	;our PID doing this?
	bneq	4$			;no, skip NT-special stuff
5$:

; Now check that this DID is one we want to consider...if indeed it is.
	.if	ndf,evax
	movl	p1(ap),r0	;get fib
	.iff
	movl	irp$l_qio_p1(r3),r0
	.endc
	ifnord #4,4(r0),2951$
	movl	4(r0),r0	;...from descriptor
	beql	2551$		;fib addr can't be 0
; FIB is now pointed to by R0, so hunt up the filenumber part of the
; DID and see if it is one we care about.
	movzwl	fib$w_did(r0),r0	;get the DID file number
	beql	4$		; zero is probably junk
	bicl	#^c<didnum-1>,r0	;mask to bitmap size
	cmpzv	r0,#1,ucb$a_dirbmp(r5),#0	;test that bit
	beql	4$		; if bit is 0, skip daemon processing
2551$:


; Now ensure that this call is not in the same JOB as the daemon.
; (This lets the daemon spawn processes to do some work.)
	pushr	#^m<r6,r7,r8,r9,r10,r11>	;get some regs
	movl	ucb$l_daemon(r5),r10	;get the daemon PID
	bleq	3$
	movzwl	r10,r7			;get process index
; like code in FQdriver...
	movl	 g^sch$gl_pcbvec,r6	;get pcb vector
	movl	(r6)[r7],r8		;get a PCB address
	tstl	r8			;ensure a system addr
	bgeq	3$			;skip if not
	cmpl	r10,pcb$l_pid(r8)	;be sure this is the daemon process
	bneq	504$			;else skip
; ok, we for sure have the daemon's PCB now. See if the JIBs match
	cmpl	pcb$l_jib(r8),pcb$l_jib(r4)	;same JIB as daemon's?
	bneq	3$			;if not, don't skip out
	popr	#^m<r6,r7,r8,r9,r10,r11>	;get regs back now
	brw	1509$			;then buzz off
504$:
	popr	#^m<r6,r7,r8,r9,r10,r11>	;get regs back now
	brw	4$
3$:
	popr	#^m<r6,r7,r8,r9,r10,r11>	;get regs back now
; crefilt
	pushl	r0
	pushl	r10
	pushl	r11
	movl	ucb$l_mbxucb(r5),r10	;get del mbx ucb if any
	bgeq	850$			;if none, can'thelp.
	bitl	#ucb$m_online,ucb$l_sts(r10)	;online?
	beql	850$			;if not no soap
	.if	df,evax
	tstl	ucb$l_refc(r10)		;anyone listening?
	.iff
	tstw	ucb$w_refc(r10)		;anyone listening?
	.endc
	beql	850$			;if no, no dmn.
	tstl	ucb$l_orb(r10)		;owner exist?
	bgeq	850$			;if geq no, skip.
; check pid now for delpid
	pushr	#^m<r5,r6,r7,r8>
	movl	g^sch$gl_maxpix,r7	;max proc index
100$:	movl	g^sch$gl_pcbvec,r6	;pcb vector
	movl	(r6)[r7],r8	;get a pcb
	tstl	r8		;got one?
	bgeq	101$		;if geq no
	cmpl	ucb$l_daemon(r5),pcb$l_pid(r8) ;this our pid?
	beql	102$		;if eql yes, all well
101$:	sobgtr	r7,100$		;check 'em all
	clrl	ucb$l_daemon(r5) ;clr dmn pid if it isn'tthere now
102$:	popr	#^m<r5,r6,r7,r8>
	tstl	ucb$l_daemon(r5) ;is the daemon around?
	beql	850$		;if not skip out
; Looks like a msg can besent, so do so. For clarity do in a sub.
	pushr	#^m<r3,r4,r5,r6,r7,r8,r9>
	pushl	r6
	jsb	sndcremsg	;send create message
	cmpl	r0,#5		;should we leave the I/O alone?
	beql	1852$		;if so no mods
; On return R9 should be UCB of the device we want
; also return FID, DID return in R6, R7, and R8 as 3 longs
;
; First replace the DID and FID
	.if	ndf,evax
	movl	p1(ap),r0	;get fib
	.iff
	movl	irp$l_qio_p1(r3),r0
	.endc
	ifnord #4,4(r0),1851$
	movl	4(r0),r0	;...from descriptor
	beql	1851$		;fib addr can't be 0
	tstl	r6		; If r6 is 0 nothing is here. Leave alone.
				; (A real file ID cannot be zero...)
	beql	1851$
; Set the FID and DID we will use.
	movl	r6,fib$w_fid(r0)
	movl	r7,fib$w_fid+4(r0)
	movl	r8,fib$w_fid+8(r0)	;insert new FID and DID
1851$:
; If new UCB is zero there's nothing to do. Also if it is the same as
; the original it's ok.
	tstl	r9
	bgeq	1852$		;if zero no change needed (or if illegal ucb)
	movl	ucb$l_backlk(r5),r8	;get UCB back link
	cmpl	r9,r8		; if same as before no change either
	beql	1852$
; Looks like we want to reset the UCB.
        .if     df,pcbmsk$$
        movl    g^ctl$gl_pcb,r4 ;get curr. pcb for sure
; if reserved shelving bit is clear we work as usual
        bbc     #pcb$v_shelving_reserved,pcb$l_sts2(r4),7502$
; if and only if the nounshelve bit is clear, just skip softlinks
        bbc     #pcb$v_nounshelve,pcb$l_sts2(r4),1852$
7502$:
        .endc
; We really need to allocate an LDT at this point and fill it in
; so we can restore the softlink at close time.
; Reset ref counts first.
	popl	r6	;now we get the CCB back. Need that.
        .if     df,evax
        decl    ucb$l_refc(r8)          ;count his refs down
        bgtr    503$
        clrl    ucb$l_refc(r8)
        .iff
        decw    ucb$w_refc(r8)          ;count his refs down
        bgtr    503$
        clrw    ucb$w_refc(r8)
        .endc
503$:
	movl	r9,ccb$l_ucb(r6)	;reset the CCB
        .if     df,evax
        incl    ucb$l_refc(r9)          ;& count 1 ref up there
        .iff
        incw    ucb$w_refc(r9)          ;& count 1 ref up there
        .endc
        movl    r9,irp$l_ucb(r3)        ;point that at this ucb
; Now this I/O is OK and the channel is set to the new point, but
; we have to arrange that we can tell how to put it back at the end.
; This means allocating an LDT (or at least the first part of one)
; and filling it in with at least enough to get the old UCB back
; at close.
        pushr   #^m<r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
; Be sure that a prcvec exists. If one does not, grab it now!!!
        tstl    ucb$l_prcvec(r5)        ;got our process data area already?
        blss    131$                    ;if so skip grabbing now.
        pushr   #^m<r0,r1,r2,r3>
        movl    g^sch$gl_maxpix,r1
        ashl    #5,r1,r1                ;get 32 bytes per process
        pushl   r1
        jsb     g^exe$alonpagvar        ;get some pool
        popl    r1
; Skip away completely if no prcvec exists or can be grabbed.
	blbs	r0,1831$
        popr    #^m<r0,r1,r2,r3>
	brw	1854$
1831$:
        zapz    (r2),r1                 ;zero it all initially
        movl    r2,ucb$l_prcvec(r5)     ;set initial pointer in UCB
        .if     ndf,wd.lst
        .iif    ndf,f.nsiz,f.nsiz=2048
        clrl    ucb$l_fnums(r5)
        movl    #f.nsiz,r1              ;bytes to get
        jsb     g^exe$alonpagvar        ;get some pool
        blbc    r0,31$
        movl    r2,ucb$l_fnums(r5)
        zapz    (r2),r1
31$:
        .endc
        popr    #^m<r0,r1,r2,r3>
131$:
; device IPL for this pseudo device is 8, same as fork!!!
        devicelock lockaddr=ucb$l_dlck(r5), -
         lockipl=ucb$b_dipl(r5),preserve=YES
        .iif df,msetrp,movl #8,mtp$trace(r5)
        jsb     findldt                 ;get our LDT if any. (normally none)
        tstl    r0                      ;did we find one ready?
; must reallocate if we found one...should never get one twice
        beql    55$                     ;if eql, good, no LDT. Grab one from po$
;got an ldt. Free it up.
        pushl   r1
; point past this LDT so link is ok
        movl    ldt$l_fwd(r0),ldt$l_fwd(r1)     ;remove this ldt from chain
; r0 = addr = ldt
        movl    ldt$l_fresiz(r0),r1     ;get size
        jsb     g^exe$deanonpgdsiz      ;free it
        popl    r1
;ok, now the bogus LDT is gone. Get a new one.
55$:
        .iif df,msetrp,movl #9,mtp$trace(r5)
        .iif df,msetrp, movl r1,mtp$r1(r5)
        tstl    r1              ;got a valid pointer?
        beqlw   1853$           ;if not, skip out
        pushl   r1
; We grab a truncated LDT here, only saves down to the regs stuff.
; This is all we need till we close. (Actually we need a bit less but
; this is a tolerable size.)
        movl    #ldt$l_regs,r1  ;ldt size to get
        jsb     g^exe$alonpagvar        ;go get pool
        popl    r1
        .iif df,msetrp,movl r0,mtp$r0(r5)
        blbs    r0,56$          ;if ok, go on
989$:   brw     1853$           ;else skip out.
56$:
        movl    r2,(r1)         ;point link at this one
        .iif df,msetrp,movl r2,mtp$ldt(r5)
        movl    r1,r9           ;save copy here
        clrl    ldt$l_fwd(r2)   ;zero our fwd pointer
        movl    #ldt$l_regs,r10
        zapz    (r2),r10        ;clear entire LDT out fassstt
; now wee have the LDT created. Set it up.
        movl    #ldt$l_regs,ldt$l_fresiz(r2)    ;set up the size to free
        movl    r6,ldt$l_ccb(r2)        ;claim the LDT for us
        movl    r2,r11          ;want the LDT less volatile
	pushr	#^m<r2,r3>
        movl    ucb$l_prcvec(r5),r1     ;start of ldt chain
        bgeq    7999$            ;lose if none
        movzwl  pcb$l_pid(r4),r2        ;get index
        ashl    #5,r2,r2                ;get tbl entry offset
; shift 5 so 32 bytes = 8 longs per entry
        addl3   r2,r1,r3                ;point r3 at our slot
        movl    r3,r1                   ;let r1 return as link addr
7999$:
        popr    #^m<r2,r3>
        movl    r1,ldt$l_prcstr(r11)    ;set up pointer to process struct
        bgeq    989$
        addl2   #8,ldt$l_prcstr(r11)    ;pass LDT base info to get to our count$
        .if     df,evax
        movl    irp$l_qio_p1(r3),r10    ;fib desc.
        .iff
        movl    p1(ap),r10
        .endc
        movl    4(r10),r10              ;point at fib ityself
        movl    fib$l_acctl(r10),ldt$l_accmd(r11)       ;save "how open"
        clrb    ldt$l_accmd+3(r11)                      ;clear window size
        .if     df,evax
        movl    pcb$l_prib(r4),ldt$l_bprio(r11)         ;save base prio
        .iff
        movzbl  pcb$b_prib(r4),ldt$l_bprio(r11)         ;save base prio
        .endc
; save file id, dir id from user call initially. Get file ID later after
; our i/o as a "better" number [should be the same].
	pushl	r9
        movl    g^ctl$gl_phd,r9         ;get proc. hdr
        movl    phd$q_privmsk(r9),ldt$l_wprv(r11)       ;save working privs
        movl    phd$q_privmsk+4(r9),ldt$l_wprv+4(r11)   ;save working privs
        movl    phd$q_authpriv(r9),ldt$l_aprv(r11)      ;save auth privs
        movl    phd$q_authpriv+4(r9),ldt$l_aprv+4(r11)  ;save auth privs
        .if     df,pcb$ar_natural_psb_def
; Allow mods of PSB based privs etc. if it exists.
; Get data from the PSB if it exists.
        movl    pcb$ar_natural_psb(r4),r9       ; point at the PSB block
        movl    psb$q_authpriv(r9),ldt$l_aprv(r11)
        movl    psb$q_authpriv+4(r9),ldt$l_aprv+4(r11)
        movl    psb$q_permpriv(r9),ldt$l_wprv(r11)
        movl    psb$q_permpriv+4(r9),ldt$l_wprv+4(r11)
        .endc
	popl	r9
        movl    r5,ldt$l_jtucb(r11)             ;save jt ucb here too
        incl    ldt$l_softf(r11)        ;flag we did have a softlink
	movl	r8,ldt$l_chnucb(r11)	;original channel ucb
        deviceunlock lockaddr=ucb$l_dlck(r5),newipl=#ipl$_astdel,preserve=YES
; Now we must attach this LDT to the new device.
; R11 is still the LDT address, R6 has the new UCB, and ldt$chnucb is old
; ucb
; R5 is still the jt ucb here...
	pushl	r5
	movl	r8,r5
; movldt grabs our devicelock (ipl 8) so be sure we free it above.
	jsb	movldt		; move the LDT to where it must go
	popl	r5
; Now we should be OK 
	brb	1854$
1853$:
        deviceunlock lockaddr=ucb$l_dlck(r5),newipl=#ipl$_astdel,preserve=YES
1854$:
        popr   #^m<r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	brb	1850$
1852$:
	popl	r6
1850$:
	popr	#^m<r3,r4,r5,r6,r7,r8,r9>
; note secret return code 4096 indicates failure.
; Now also fix the I/O up after return.
; 1. Clear extend size since the daemon should have allocated this
;    much space (and ensured it was free) before returning, if
;    create was legal,
; 2. Change io$_create function code in the IRP to io$_access (relying on
;    the fact that the standard access and create routines are handled
;    by the SAME FDT routines so we need not reroute the continuation
;    also)
; 3. Insert the returned FID in the user FIB. Note FID should return in the
; user FIB...
;
; If we got a different UCB back, change the channel to that.
;
; We take care of the extend size and filling in the FIB in sndcremsg
; but need to mess with the IRP here.
	cmpl	r0,#5		;should we leave the I/O alone?
	beql	850$		;if so no mods
;ok, reset fcn code. ASSUMES that fcn code is at the LOW 6 bits of
; the longword!!!
	movl	irp$l_func(r3),r11	;get the function code
	bicl	#irp$m_fcode,r11	;clear the function code out
	bicl	#irp$m_extend,r11	;clear extend modifier too
	bisl	#io$_access,r11		;insert io$_access function code
	movl	r11,irp$l_func(r3)	;replace fcn code in IRP now.
; IRP should be all set to send on its merry way now.
850$:
800$:
	popl	r11
	popl	r10
	cmpl	#3,r0		;fake success status?
	beql	2999$
	blbc	r0,1999$
	popl	r0

999$:	brw	1509$
;	popr	#^m<r0,r5>
;	movl	#1,r0
;	rsb
1999$:	popl	r0		;restore the stack
	popr	#^m<r0,r5>
	movl	#ss$_nopriv,r0	;return no priv if daemon rejected the op
	call_abortio
;	ret
2999$:	popl	r0
	.if	df,zotdi$
; ensure if faking success that dir id looks empty so we get no msg
	.if	ndf,evax
	movl	p1(ap),r0	;get fib
	.iff
	movl	irp$l_qio_p1(r3),r0
	.endc
	ifnord #4,4(r0),2951$
	movl	4(r0),r0	;...from descriptor
	beql	2951$		;fib addr can't be 0
	clrl	fib$w_did(r0)	;clear dir id
	clrw	fib$w_did+4(r0)	;(6 bytes)
	.endc
2951$:	popr	#^m<r0,r5>
	movl	#1,r0
	call_finishioc do_ret=yes
;	rsb
; End of special create-arb type processing
4$:
;

	bitl	#8,ucb$l_ctlflgs(r5)	;doing cbt alloc on create?
; note NO extend size change on create...too darn risky...
	beql	8810$			;if eql no
	pushl	r0
	.if	ndf,evax
	movl	p1(ap),r0	;get fib
	.iff
	movl	irp$l_qio_p1(r3),r0
	.endc
	ifnord #4,4(r0),10$
	movl	4(r0),r0	;...from descriptor
	ifnord #4,fib$w_exctl(r0),10$
	bitw	#fib$m_extend,fib$w_exctl(r0)	;extending at all?
	beqlw	10$			;if no extend, leave fib alone
; Because contiguous best try allocation flushes the entire extend cache,
; it can cause a tremendous performance hit. Therefore allow it to be
; separately switched so that the benefits of longer extents can be had
; if desired without forcing this flushing every time a file is extended.
	bitl	#32,ucb$l_ctlflgs(r5)		;separate control for setting contig best try
	beql	10$
; leave contig and contig-best-try alone
	bitw	#<fib$m_alcon!fib$m_alconb>,fib$w_exctl(r0)	;contig alloc?
	bneq	10$		;if contig leave it alone
	bisw	#fib$m_alconb,fib$w_exctl(r0)	;else set cbt alloc
10$:
	popl	r0
8810$:
	bitl	#512,ucb$l_ctlflgs(r5)	;doing space control?
	beql	21$
	pushl	r0
	.if	ndf,evax
	movl	p1(ap),r0	;get fib
	.iff
	movl	irp$l_qio_p1(r3),r0
	.endc
	ifnord #4,4(r0),20$
	movl	4(r0),r0	;...from descriptor
	brw	mspc		;go handle space control now
20$:	popl	r0
21$:	brw	1509$
;
PopOut: .jsb_entry output=r0
;	popr	#^m<r0,r5>
	bsbw	pors
	rsb
pors: .jsb_entry output=r0
; Here need to return to the "standard" FDT routine. Do so by computing
; the address in the FDT table of the normal host and calling that, then
; returning.
        EXTZV   #IRP$V_FCODE,#IRP$S_FCODE,IRP$L_FUNC(R3),R1     ; GET FCN CODE
	pushr	#^m<r6,r7,r8,r9,r10>
	movl	r1,r10
	jsb	getjtucb		;find JT UCB checking for extra links
	tstl	r0			;got it?
	bgeq	199$			;if not skip out
	movl	ucb$l_oldfdt(r0),r7	;get address of previous FDT
	bgeq	199$			;ensure ok...
;	movl	ucb$l_ddt(r5),r7	;find FDT
; Here rely on the fact that we got here via our modified FDT call and that
; the orig. FDT is stored just a bit past the current one.
;	movl	<ucb$l_oldfdt-ucb$l_myfdt>(r7),r7	;point at orig. FDT
	addl2	#8,r7			;point at one of 64 fdt addresses
	movl	(r7)[r10],r8		;r7 is desired routine address
;now call the "official" FDT code
	pushl	r6	;ccb
	pushl	r5	;ucb
	pushl	r4	;pcb
	pushl	r3	;irp
	calls	#4,(r8)			;Call the original routine
	popr	#^m<r6,r7,r8,r9,r10>
; Now return as the original routine would.
; caller does this
	rsb
;	ret
199$:
	popr	#^m<r6,r7,r8,r9,r10>
	movl	#16,r0
	call_abortio do_ret=no
	rsb
;	ret
;	rsb
mfyfilt: $driver_fdt_entry	;filter on MODIFY requests (e.g. extend)
; First do some preliminary checks for sanity.
; 1. Channel must NOT be kernel mode
; 2. Not a movefile
	tstl	r6		;is there a CCB (must be +)
	bgtr	5509$
6509$:	bsbw	pors
	ret
5509$:
;	bleq	pors		;if not skip out
	cmpb	ccb$b_amod(r6),#1	;knl mode access?
	bleq	6509$		;leave knl mode chnls alone!
;funct modifiers are bits 6-15
; this is hex ffc0
; Normal io$_modify should have no modifiers, so if it has it's
; for something else; leave that alone.
	.if	ndf,evax
	bitw	#^xFFC0,irp$w_func(r3) ;this a movefile or other modifier?
	.iff
; axp 6.1 sets 2000 bit for some reason. However movefile bit is 1000 hex
; so do not mess with movefile but let 2000 bit by.
	bitl	#^xDFC0,irp$l_func(r3) ;this a movefile or other modifier?
	.endc
	bneq	6509$		;if so ignore it here.
; If both pcb$m_nounshelve and pcb$m_shelving_Reserved bits are
; set in PCB, omit the filtering.
	.if	df,pcbmsk$$
; if reserved shelving bit is clear we filter as usual
	bbc	#pcb$v_shelving_reserved,pcb$l_sts2(r4),502$
; if and only if both bits are set we skip out
	bbs	#pcb$v_nounshelve,pcb$l_sts2(r4),6509$
502$:
	.endc
	pushr	#^m<r0,r5>
; original r5 now at 4(sp). Must get that to continue the ops.
	jsb	getJTucb		;find JTdriver ucb
	tstl	r0
	blss	509$
1509$:
	popr	#^m<r0,r5>
	bsbw	popout
	ret
509$:
;	bgeqw	popout
	movl	r5,ucb$l_backlk(r0)	;save link'd ucb in ours too.
	movl	r0,r5			;point R5 at JT UCB
; Make sure this isn't one of OUR daemons
	cmpl	pcb$l_pid(r4),ucb$l_daemon(r5)	;open etc. daemon?
	beqlw	1509$
	cmpl	pcb$l_pid(r4),ucb$l_exdmn(r5)	;not extend daemon
	beqlw	1509$
	cmpl	pcb$l_pid(r4),ucb$l_deldmn(r5)
	beqlw	1509$			;not delete daemon
	cmpl	pcb$l_pid(r4),ucb$l_exempt(r5)	;exempted pid?
	beqlw	1509$
	cmpl	pcb$l_pid(r4),ucb$l_exempt+4(r5) ;exempted pid?
	beqlw	1509$
	cmpl	pcb$l_pid(r4),ucb$l_exempt+8(r5) ;exempted pid?
	beqlw	1509$
	cmpl	pcb$l_pid(r4),ucb$l_exempt+12(r5) ;exempted pid?
	beqlw	1509$
;make sure not a knl mode channel (leave the XQP channel alone!!!)
	cmpb	ccb$b_amod(r6),#1	;this the XQP's chnl?
	bleqw	1509$			; if so scram NOW.
; Now ensure that this call is not in the same JOB as the daemon.
; (This lets the daemon spawn processes to do some work.)
	pushr	#^m<r6,r7,r8,r9,r10,r11>	;get some regs
	movl	ucb$l_exdmn(r5),r10	;get the daemon PID
	bleq	5$
	movzwl	r10,r7			;get process index
; like code in FQdriver...
	movl	 g^sch$gl_pcbvec,r6	;get pcb vector
	movl	(r6)[r7],r8		;get a PCB address
	tstl	r8			;ensure a system addr
	bgeq	5$			;skip if not
	cmpl	r10,pcb$l_pid(r8)	;be sure this is the daemon process
	bneq	5$			;else skip
; ok, we for sure have the daemon's PCB now. See if the JIBs match
	cmpl	pcb$l_jib(r8),pcb$l_jib(r4)	;same JIB as daemon's?
	bneq	5$			;if not, don't skip out
	popr	#^m<r6,r7,r8,r9,r10,r11>	;get regs back now
48$:	brw	1509$			;then buzz off
5$:
	popr	#^m<r6,r7,r8,r9,r10,r11>	;get regs back now
	bitl	i^#2,ucb$l_ctlflgs(r5)	;look at mfy?
	bneqw	mfycmn			;if neq yes
; (test later will see about space control if doing this)
	bitl	#512,ucb$l_ctlflgs(r5)	;doing space control?
	beql	701$
	pushl	r0
	.if	ndf,evax
	movl	p1(ap),r0	;get fib
	.iff
	movl	irp$l_qio_p1(r3),r0
	.endc
	beql	702$
	ifnord #4,4(r0),702$
	movl	4(r0),r0	;...from descriptor
	beql	702$
7701$:	brw	mspc		;if so go handle space control
701$:
	popr	#^m<r0,r5>
	bsbw	pors
	ret
702$:	POPL	R0
	popr	#^m<r0,r5>
	bsbw	pors
	ret
mspcj:	popl	r0
	popr	#^m<r0,r5>
	bsbw	pors
	ret
mfycmn:
; here we can modify request fields in the FIB the user supplies to reduce
; fragmentation...e.g. set fib$l_exsz bigger or set fib$m_alconb bit
; in fib$w_exctl IFF fib$m_alcon is not set & set fib$m_aldef.
;
	pushl	r0
	.if	ndf,evax
	movl	p1(ap),r0	;get fib
	.iff
	movl	irp$l_qio_p1(r3),r0
	.endc
	ifnord #4,4(r0),mspcj
	movl	4(r0),r0	;...from descriptor
	ifnord #4,fib$w_exctl(r0),mspcj
	bitw	#fib$m_extend,fib$w_exctl(r0)	;extending at all?
	beqlw	mspc			;if no extend, leave fib alone
; Because contiguous best try allocation flushes the entire extend cache,
; it can cause a tremendous performance hit. Therefore allow it to be
; separately switched so that the benefits of longer extents can be had
; if desired without forcing this flushing every time a file is extended.
	bitl	#32,ucb$l_ctlflgs(r5)		;separate control for setting contig best try
	beql	1$
; leave contig and contig-best-try alone
	bitw	#<fib$m_alcon!fib$m_alconb>,fib$w_exctl(r0)	;contig alloc?
	bneq	1$		;if contig leave it alone
; allow this on every nth extend.
; This will allow periodic flushes of the extent cache but will let
; it not be made totally useless. By flushing the extent cache periodically
; we can try to reduce the fragmentation it induces.
; if bit 16384 is not set, do not set aldef.
	bitl	#16384,ucb$l_ctlflgs(r5)	;allow aldef?
	beql	704$
	bisw	#<fib$m_aldef>,fib$w_exctl(r0) ;set to use vol default if
704$:					;bigger than program's
	decl	ucb$l_cbtctr(r5)	;count down
	bgtr	1$			;and if >0 don't set cbt yet
	movl	ucb$l_cbtini(r5),ucb$l_cbtctr(r5)	;else reset counter
	bisw	#<fib$m_alconb>,fib$w_exctl(r0) ;else turn on contig best
					;try and turn on use of
					;system default extension if
					;larger than program default
1$:
; One can add code to check file size and bump extension by more than default if
; it's big (for example, extend by 10% of its' size, not by a few blocks at a time).
	pushr	#^m<r2,r3,r4,r5,r6,r7,r8>
	bitw	#<fib$m_alcon>,fib$w_exctl(r0)	;contig alloc?
	bneqw	222$	;leave size alone for contig alloc
	movl	ccb$l_wind(r6),r7	;get window block
	bgeq	222$			;guard
	movl	wcb$l_fcb(r7),r8	;and file control blkock
	bgeq	222$			;guard
	movl	fcb$l_filesize(r8),r6	;get filesize
	beql	222$
; It is suggested to divide by acp$gb_window instead of 10...
; this is the acp_window sysgen param (default 7), the number of retrieval pointers
; present per window by default. This has no direct relation to size, but one must
; expect at least one retrieval pointer needs to change. In the default situation
; say 1/4th of file size can be used.
;
; The fraction starts at 1/4, but can be anywhere from 1/1 to 1/1000
	divl2	ucb$l_frac(r5),r6	;get 1/4 of current size or so
	incl	r6			;plus one...for good luck
;fncymod=1	;chop this if desired
;	.if	df,fncymd
	cmpl	r6,ucb$l_maxxt(r5)	;extending over max (nominally 120000)
	bleq	1222$
	movl	ucb$l_maxxt(r5),r6	;clamp to max what we're forcing
1222$:
;	.endc
	cmpl	r6,ucb$l_minxt(r5)	;if less than 10 leave alone too
	bgeq	1223$
	movl	ucb$l_minxt(r5),r6	;at least grab this minimum
1223$:
;	.if	df,fncymd
; never try to grab over1/8 of total free space.
	movl	ucb$l_backlk(r5),r8	;get host ucb (set just above)
	bgeq	222$			;(better be there)
	movl	ucb$l_vcb(r8),r8	;point at vcb
	bgeq	222$
	movl	vcb$l_free(r8),r8	;no. blks free
	ashl	#-3,r8,r8		;free space /8
	cmpl	r6,r8			;extent over freespc/8?
;	bgtr	222$			;if so don't push it here
	bleq	3223$			;if not all still ok
	movl	r8,r6			;else clamp to free/8
3223$:
;	.endc
	cmpl	r6,fib$l_exsz(r0)	;make sure we're increasing size
	bleq	222$			;if less than user wants, leave alone

; if 4096 bit is clear, allow size ctl always. Otherwise only if aldef set.
	bitl	#4096,ucb$l_ctlflgs(r5)
	beql	2222$
	bitw	#<fib$m_aldef>,fib$w_exctl(r0) ;set to use vol default if
	beql	222$			;if aldef NOT set, leave size alone.
2222$:
	movl	r6,fib$l_exsz(r0)	;fill in as new extend size
222$:
	popr	#^m<r2,r3,r4,r5,r6,r7,r8>
; fall thru to space control
mspc:
; on entry here r0 has user FIB address.
	bitl	#512,ucb$l_ctlflgs(r5)	;doing space control?
	beqlw	800$			;guard against unwanted calls
	bitw	#fib$m_extend,fib$w_exctl(r0) ;extending?
	beqlw	800$		;if not no work here
; Now send msg to space daemon and await return via skast
; if user request will exhaust disk space but yet is less than 1/8
; of disk size. (Some requests are just too darn hard to handle; if
; the request is for over 1/8 of disk size, we probably can't clean
; off enough to fix it anyway.
; ucb$l_exdmn & ucb$l_exmbx will be fields we use.
	pushr	#^m<r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
;
; Note: in this area we leave r3, r4, r5, r6, r7, and r8 pretty
; much alone since FDT processing uses those; r5 can be JT or target
; UCB, but the others get left intact so we can save & restore the i/o
; properly.
	movl	ucb$l_backlk(r5),r10
	bgeq	850$			;(better be there)
	movl	r10,r9			;keep ucb around for size chk
	movl	ucb$l_vcb(r10),r10	;point at vcb
	bgeq	850$
	movl	vcb$l_free(r10),r10	;no. blks free
	cmpl	fib$l_exsz(r0),r10		;enough room there?
	blssu	850$			;if lss then all OK
	movl	ucb$l_maxblock(r9),r9	;disk size
	ashl	#-3,r9,r9		;divide by 8
	cmpl	r10,r9			;size req. > dsksize/8 ?
	bgeq	850$			;if so, cannot help. Let it fail.
; Looks like we CAN help, if there's someone out there we can yell for.
; Check this.
	movl	r0,r9			;save user FIB address
; (r0 is too volatile)
	movl	ucb$l_exmbx(r5),r10	;get extend mbx ucb if any
	bgeq	850$			;if none, can'thelp.
	bitl	#ucb$m_online,ucb$l_sts(r10)	;online?
	beql	850$			;if not no soap
	.if	df,evax
	tstl	ucb$l_refc(r10)		;anyone listening?
	.iff
	tstw	ucb$w_refc(r10)		;anyone listening?
	.endc
	beql	850$			;if no, no dmn.
	tstl	ucb$l_orb(r10)		;owner exist?
	bgeq	850$			;if geq no, skip.
; check pid now for expid
	pushr	#^m<r5,r6,r7,r8>
	movl	g^sch$gl_maxpix,r7	;max proc index
100$:	movl	g^sch$gl_pcbvec,r6	;pcb vector
	movl	(r6)[r7],r8	;get a pcb
	tstl	r8		;got one?
	bgeq	101$		;if geq no
	cmpl	ucb$l_exdmn(r5),pcb$l_pid(r8) ;this our pid?
	beql	102$		;if eql yes, all well
101$:	sobgtr	r7,100$		;check 'em all
	clrl	ucb$l_exdmn(r5)	;clr dmn pid if it isn'tthere now
102$:	popr	#^m<r5,r6,r7,r8>
	tstl	ucb$l_exdmn(r5)	;is thedaemon around?
	beql	850$		;if not skip out
; Looks like a msg can besent, so do so. For clarity do in a sub.
	jsb	sndexmsg	;send extend message
850$:	popr	#^m<r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
800$:
	popl	r0
	popr	#^m<r0,r5>
	movl	#1,r0
	bsbw	pors
	ret
; sndexmsg - called with r5=JT ucb, r9=user FIB address
; Send a message to free space to the extend daemon via ucb$l_exmbx
; passing device and size needed.
sndexmsg: .jsb_entry
; "can" the IRP status so it can continue, using a pool buffer.
	movl	#120,r1		;get some room
	jsb	g^exe$alonpagvar	;via vms routines
	blbs	r0,1$
	rsb			;just return if out of space
1$:
	zapz	(r2),#120	;zero area
	movl	r2,r11		;save msg blk address
	movpsl	116(r2)		;save orig psl at 116 off block
	pushr	#^m<r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	movl	r11,(r2)	;store address of blk in msg block
; Note that R3 to R8 are unaltered from their original state
; here. We'll save these, then restore them after the AST
; and continue the thread. During this thread, we send a message
; to the daemon (with msgblk and address of sndexast and dvcname/unit
; and size needed) and then enter a wait loop awaiting a flag being
; set (wait for efn 31 in the loop). The AST will just set the
; flag and let things continue; it should get the msg blk as
; a parameter of the AST.
	movl	ucb$l_backlk(r5),r0	;get original dvc ucb
	movl	ucb$l_ddb(r0),r1	;get DDB (name is there)
	movab	ddb$t_name(r1),r1	;point at dvc name
	movl	#2,4(r11)		;flag this an extend call
	movl	(r1)+,8(r11)		;copy dvc name
	movl	(r1)+,12(r11)
	movl	(r1)+,16(r11)
	movl	(r1)+,20(r11)		;counted name
	movzwl	ucb$w_unit(r0),24(r11)	;unit no.
; Save the regs in case the daemon needs them.
	movl	r3,28(r11)		;irp
	movl	g^ctl$gl_pcb,r4		;be sure pcb is in r4
	movl	r4,32(r11)
	movl	r0,36(r11)		;orig. r5 = orig. dvc UCB
	movl	r6,40(r11)		;ccb addr
	movl	r7,44(r11)
	movl	r8,48(r11)		;copy r7, r8
	movl	r9,52(r11)		;user FIB
	movl	fib$l_exsz(r9),56(r11)	;size needed
	movl	fib$w_fid(r9),60(r11)	;copy file id
	movl	fib$w_fid+4(r9),64(r11)
	movl	fib$l_acctl(r9),68(r11)	;how open
	movab	sndexast,72(r11)	;where to send skast back to
	movl	g^ctl$gl_pcb,76(r11)	;send pcb
	movl	g^ctl$gl_pcb,r4
	movl	pcb$l_pid(r4),80(r11)
	movl	pcb$l_epid(r4),84(r11)
	movl	ucb$l_ddb(r0),r1	;get DDB (name is there)
	movl	ddb$l_allocls(r1),88(r11) ;save alloc class
	movl	ddb$l_sb(r1),r1		;get sys block if any
	bgeq	833$			;if none, omit name grab
	movl	sb$t_nodename(r1),92(r11) ;else save nodename
	movl	sb$t_nodename+4(r1),96(r11)
833$:
; Reserve 4(r11) as wait flag.
; emit a message now to the daemon and wait for him to set us
; runnable again (setting ipl0 meanwhile to besure he can!)
	pushr	#^m<r3,r4,r5>
	movl	#120,r3			;size of msg
	movl	r5,r10			;save jtdriver ucb
	movl	ucb$l_exmbx(r5),r5	;mailbox daemon ucb
	movl	r11,r4			;addr of msg to send
	jsb	g^exe$wrtmailbox	;send it to the daemon
	popr	#^m<r3,r4,r5>
	blbc	r0,40$			;br to dealloc space if we fail
	movl	#pcb$m_nodelet,r9	;set what bit to alter (if any)
	movl	g^ctl$gl_pcb,r4		;get current pcb address
	bitl	#<pcb$m_nodelet>,pcb$l_sts(r4)	;is delete inhibited now?
	beql	67$			;if not set now, we may alter
	clrl	r9			;else leave alone
67$:	bisl	r9,pcb$l_sts(r4)	;inhibit process delete
					; across ipl0 interval
	clrl	4(r11)			;ensure we do synch...
; Wait for the AST to fire here.
	setipl ipl=#0,environ=UNIPROCESSOR
; Now we can issue a wait that a skast can interrupt.
65$:	tstl	4(r11)		;done the wait?
	bneq	50$
	pushl	#31
	calls	#1,g^sys$clref
	tstl	4(r11)
	bneq	50$
	pushl	#31		;wait for ef 31
	calls	#1,g^sys$waitfr
	brb	65$
50$:
; now back to IPL2 to ensure no AST interruptions for what is left.
	setipl ipl=#2,environ=UNIPROCESSOR
	bicl	r9,pcb$l_sts(r4)	;enable delete if we were inhibiting it
40$:
; restore psl prev mode to what it should be to reissue user FDT codes
	evax_ldq	r16,116(r11)	;get the original PSL
	evax_wr_ps_sw			;write prev mode back again
	movl	r11,r0
	movl	#120,r1			;size
	jsb	g^exe$deanonpgdsiz	;free the msg block
	popr	#^m<r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
; Once back here, all registers are OK and the FDT loop
; should just continue where it left off.
	rsb
; sndexast -
; return control from extend daemon to let the i/o continue.
; AST arg is scratch block address
sndexast: .jsb_entry
	movl	acb$l_astprm(r5),r11	;msg blk address
	cmpl	#4096,4(r11)		;if special returncode, leave it.
	beql	1$
	cmpl	#3,4(r11)		;leave fake-success alone too
	beql	1$
	movl	#1,4(r11)		;let the wait end
1$:	pushl	#31		; set ef 31
	calls	#1,g^sys$setef	;set the ef
	movl	r5,r0		;point at acb
	movl	#<acb$c_length>,r1	;size
	jsb	g^exe$deanonpgdsiz	;deallocate the acb
	movl	#1,r0		;say all well
	rsb
; sndcrast -
; return control from create daemon to let the i/o continue.
; AST arg is scratch block address
sndcrast: .jsb_entry
	movl	acb$l_astprm(r5),r11	;msg blk address
; fill in FID in user FIB in caller
	cmpl	#4096,4(r11)		;if special returncode, leave it.
	beql	1$
	cmpl	#3,4(r11)		;leave fake-success alone too
	beql	1$
	cmpl	#5,4(r11)		;leave 5 alone too...says fake succ.
	beql	1$
	movl	#1,4(r11)		;let the wait end
1$:	pushl	#31		; set ef 31
	calls	#1,g^sys$setef	;set the ef
	movl	r5,r0		;point at acb
	movl	#<acb$c_length>,r1	;size
	jsb	g^exe$deanonpgdsiz	;deallocate the acb
	movl	#1,r0		;say all well
	rsb
; snddelmsg - called with r5=JT ucb, r9=user FIB address
; Send a message of file delete to the delete daemon via ucb$l_delmbx
; passing device name & fileinfo
; On entry if R11=1, chk security too.
snddelmsg: .jsb_entry
; "can" the IRP status so it can continue, using a pool buffer.
	.if	ndf,hsmonly
; if bit 64 set, and if r11=0, send no message, so msg goes to daemon
; only for knl tagged files if bit 64 set.
	bitl	#64,ucb$l_ctlflgs(r5)
	beql	100$
	tstl	r11		;this file tagged for security test?
	bneq	100$		;yes, do it
	rsb			;no, leave
100$:
	.endc
	movl	#<120+264>,r1		;get some room
	jsb	g^exe$alonpagvar	;via vms routines
	blbs	r0,1$
	rsb			;just return if out of space
1$:
	zapz	(r2),#<120+264>	;zero area
	movpsl	116(r2)		;save ps so we can get back prev mode
	movl	r11,112(r2)	;save flag of security test
	movl	r2,r11		;save msg blk address
	pushr	#^m<r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	movl	r11,(r2)	;store address of blk in msg block
; Note that R3 to R8 are unaltered from their original state
; here. We'll save these, then restore them after the AST
; and continue the thread. During this thread, we send a message
; to the daemon (with msgblk and address of sndexast and dvcname/unit
; and size needed) and then enter a wait loop awaiting a flag being
; set (wait for efn 31 in the loop). The AST will just set the
; flag and let things continue; it should get the msg blk as
; a parameter of the AST.
	movl	ucb$l_backlk(r5),r0	;get original dvc ucb
	movl	ucb$l_ddb(r0),r1	;get DDB (name is there)
	movab	ddb$t_name(r1),r1	;point at dvc name
	movl	#3,4(r11)		;flag a delete call
	movl	(r1)+,8(r11)		;copy dvc name
	movl	(r1)+,12(r11)
	movl	(r1)+,16(r11)
	movl	(r1)+,20(r11)		;counted name
	movzwl	ucb$w_unit(r0),24(r11)	;unit no.
; Save the regs in case the daemon needs them.
	movl	r3,28(r11)		;irp
	movl	g^ctl$gl_pcb,r4		;be sure pcb is in r4
	movl	r4,32(r11)
	movl	r0,36(r11)		;orig. r5 = orig. dvc UCB
	movl	r6,40(r11)		;ccb addr
	movl	r7,44(r11)
	movl	r8,48(r11)		;copy r7, r8
	movl	r9,52(r11)		;user FIB
	movl	fib$l_exsz(r9),56(r11)	;size needed
	movl	fib$w_fid(r9),60(r11)	;copy file id
	movl	fib$w_fid+4(r9),64(r11)
	movl	fib$w_fid+8(r9),120(r11)	;Dir ID here
	movl	fib$l_acctl(r9),68(r11)	;how open
; Let the extend AST code serve here too.
	movab	sndexast,72(r11)	;where to send skast back to
	movl	fib$w_did(r9),76(r11)	;send did too
	movzwl	fib$w_did+4(r9),80(r11)
	movl	g^ctl$gl_pcb,84(r11)	;send pcb
	movl	g^ctl$gl_pcb,r4
	movl	pcb$l_pid(r4),88(r11)
	movl	pcb$l_epid(r4),92(r11)
	movl	ucb$l_ddb(r0),r1	;get DDB (name is there)
	movl	ddb$l_allocls(r1),96(r11) ;save alloc class
	movl	ddb$l_sb(r1),r1		;get sys block if any
	bgeq	833$			;if none, omit name grab
	movl	sb$t_nodename(r1),100(r11) ;else save nodename
	movl	sb$t_nodename+4(r1),104(r11)
833$:
;
; If FID is null and P2 (filename descr.) is not, store filename for the
; daemon to use. It'll have to look the file up to get the file ID if that
; happens. Leave this to the daemon for simplicity of the kernel mode
; code here.
	tstl	60(r11)			; is file ID there?
	bneq	843$			; if neq yes, just use that.
; fooey. no file id. Try and grab the filename.
	pushr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
; now we can movc w/o hassles.
	movl	irp$l_qio_p2(r3),r10	;get arg descriptor
	beql	844$
	movl	(r10),124(r11)		;save count here
	bleq	844$
	movl	(r10),r0
	cmpl	r0,#<264-8>
	bleq	845$
	movl	#<264-8>,r0
845$:				;clamp byte count to space available
	movab	128(r11),r1		;destination address
	movl	4(r10),r2		;source address
	beql	844$
	movc3	r0,(r2),(r1)		;copy the data into the msg buffer
844$:
	popr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
843$:
; Reserve 4(r11) as wait flag.
; emit a message now to the daemon and wait for him to set us
; runnable again (setting ipl0 meanwhile to besure he can!)
	pushr	#^m<r3,r4,r5>
	movl	#<120+264>,r3			;size of msg
	movl	r5,r10			;save jtdriver ucb
	movl	ucb$l_delmbx(r5),r5	;mailbox daemon ucb
	movl	r11,r4			;addr of msg to send
	jsb	g^exe$wrtmailbox	;send it to the daemon
	popr	#^m<r3,r4,r5>
	blbc	r0,40$			;br to dealloc space if we fail
	movl	#pcb$m_nodelet,r9	;set what bit to alter (if any)
	movl	g^ctl$gl_pcb,r4		;get current pcb address
	bitl	#<pcb$m_nodelet>,pcb$l_sts(r4)	;is delete inhibited now?
	beql	67$			;if not set now, we may alter
	clrl	r9			;else leave alone
67$:	bisl	r9,pcb$l_sts(r4)	;inhibit process delete
					; across ipl0 interval
	clrl	4(r11)			; zero our wait cell so we do synch
; Wait for the AST to fire here.
	setipl ipl=#0,environ=UNIPROCESSOR
; Now we can issue a wait that a skast can interrupt.
65$:
	tstl	4(r11)		;done the wait?
	bneq	50$
	pushl	#31
	calls	#1,g^sys$clref	;clear efn 31
	tstl	4(r11)
	bneq	50$		;be sure wait still pending
	pushl	#31		;wait for ef 31
	calls	#1,g^sys$waitfr
	brb	65$
50$:
; now back to IPL2 to ensure no AST interruptions for what is left.
	setipl ipl=#2,environ=UNIPROCESSOR
	movl	g^ctl$gl_pcb,r4		;get current pcb address
	bicl	r9,pcb$l_sts(r4)	;enable delete if we were inhibiting it
	movl	4(r11),r0		;if we got to daemon, flag ok
	brb	41$
40$:	movl	#1,r0		;let it go if mbx err
41$:	pushl	r0
; restore psl prev mode to what it should be to reissue user FDT codes
	evax_ldq	r16,116(r11)	;get the original PSL
	evax_wr_ps_sw			;write prev mode back again
	movl	r11,r0
	movl	#<120+264>,r1		;size
	jsb	g^exe$deanonpgdsiz	;free the msg block
	popl	r0
	popr	#^m<r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
; Once back here, all registers are OK and the FDT loop
; should just continue where it left off.
	rsb
; sndcremsg - called with r5=JT ucb, AP as at call on VAX or R3=IRP
; Send a message of file create to the open daemon via ucb$l_delmbx
; passing device name & fileinfo
; On entry if R11=1, chk security too.
sndcremsg: .jsb_entry output=<r0,r6,r7,r8,r9>
	.if	ndf,evax
	movl	p1(ap),r0	;get fib
	.iff
	movl	irp$l_qio_p1(r3),r0
	.endc
	movl	4(r0),r9		;user FIB address.
	movl	(r0),r8			;user FIB length
	movl	#<120+264+16+116>,r1		;get some room
	jsb	g^exe$alonpagvar	;via vms routines
	blbs	r0,1$
	clrl	r9
	rsb			;just return if out of space
1$:
	zapz	(r2),#<120+264+16+116>	;zero area
	movpsl	116(r2)		;save ps so we can get back prev mode
	movl	r11,112(r2)	;save flag of security test
	movl	r2,r11		;save msg blk address
	pushr	#^m<r1,r2,r3,r4,r5,r10,r11>
	movl	r11,(r2)	;store address of blk in msg block
; Note that R3 to R8 are unaltered from their original state
; here. We'll save these, then restore them after the AST
; and continue the thread. During this thread, we send a message
; to the daemon (with msgblk and address of sndexast and dvcname/unit
; and size needed) and then enter a wait loop awaiting a flag being
; set (wait for efn 31 in the loop). The AST will just set the
; flag and let things continue; it should get the msg blk as
; a parameter of the AST.
	movl	ucb$l_backlk(r5),r0	;get original dvc ucb
	movl	ucb$l_ddb(r0),r1	;get DDB (name is there)
	movab	ddb$t_name(r1),r1	;point at dvc name
	movl	#4,4(r11)		;flag a create call
	movl	(r1)+,8(r11)		;copy dvc name
	movl	(r1)+,12(r11)
	movl	(r1)+,16(r11)
	movl	(r1)+,20(r11)		;counted name
	movzwl	ucb$w_unit(r0),24(r11)	;unit no.
; Save the regs in case the daemon needs them.
	movl	r3,28(r11)		;irp
	movl	g^ctl$gl_pcb,r4		;be sure pcb is in r4
	movl	r4,32(r11)
	movl	r0,36(r11)		;orig. r5 = orig. dvc UCB
	movl	r6,40(r11)		;ccb addr
	movl	r7,44(r11)
	movl	r8,48(r11)		;copy r7, r8
msg.fib=52
msg.rtnfid=120+264	;offset to returned FID from daemon
	movl	r9,52(r11)		;user FIB
	movl	fib$l_exsz(r9),56(r11)	;size needed
; File ID normally will be zero; daemon will have to fish around to grab
; filename, so pass args. The IRP has them on Alpha.
	movl	fib$w_fid(r9),60(r11)	;copy file id
	movl	fib$w_fid+4(r9),64(r11)
	movl	fib$w_fid+8(r9),120(r11)	;Dir ID here
	movl	fib$l_acctl(r9),68(r11)	;how open
; Let the extend AST code serve here too.
	movab	sndcrast,72(r11)	;where to send skast back to
	movl	fib$w_did(r9),76(r11)	;send did too
	movzwl	fib$w_did+4(r9),80(r11)
	movl	g^ctl$gl_pcb,84(r11)	;send pcb
	movl	g^ctl$gl_pcb,r4
	movl	pcb$l_pid(r4),88(r11)	;pass PCBs we need
	movl	pcb$l_epid(r4),92(r11)
	movl	ucb$l_ddb(r0),r1	;get DDB (name is there)
	movl	ddb$l_allocls(r1),96(r11) ;save alloc class
	movl	ddb$l_sb(r1),r1		;get sys block if any
	bgeq	833$			;if none, omit name grab
	movl	sb$t_nodename(r1),100(r11) ;else save nodename
	movl	sb$t_nodename+4(r1),104(r11)
833$:
;
; If FID is null and P2 (filename descr.) is not, store filename for the
; daemon to use. It'll have to look the file up to get the file ID if that
; happens. Leave this to the daemon for simplicity of the kernel mode
; code here. This name being here will simplify creating the file in the
; daemon.
	tstl	60(r11)			; is file ID there?
	bneq	843$			; if neq yes, just use that.
; fooey. no file id. Try and grab the filename.
	pushr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
; now we can movc w/o hassles.
	movl	irp$l_qio_p2(r3),r10	;get arg descriptor
	beql	844$
	movl	(r10),124(r11)		;save count here
	bleq	844$
	movl	(r10),r0
	cmpl	r0,#<264-8>
	bleq	845$
	movl	#<264-8>,r0
845$:				;clamp byte count to space available
	movab	128(r11),r1		;destination address
	movl	4(r10),r2		;source address
	beql	844$
	movc3	r0,(r2),(r1)		;copy the data into the msg buffer
844$:
	popr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
843$:
; now copy the FIB (well, 72 bytes of it!) to our structure.
	pushr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	movab	<120+264+16>(r11),R10	;start of fib save area

; R8 computed at start as user FIB size
	tstl	r8
	beql	3843$
	cmpl	r8,#80			;limit to 80
	bleq	2843$
3843$:
	movl	#80,r8
2843$:
; Copy only data user HAS in his FIB.
	movc3	r8,(r9),(r10)		;copy the data
	popr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>

; Reserve 4(r11) as wait flag.
; emit a message now to the daemon and wait for him to set us
; runnable again (setting ipl0 meanwhile to besure he can!)
	pushr	#^m<r3,r4,r5>
	movl	#<120+264+16+116>,r3			;size of msg
	movl	r5,r10			;save jtdriver ucb
	movl	ucb$l_delmbx(r5),r5	;mailbox daemon ucb
	movl	r11,r4			;addr of msg to send
	jsb	g^exe$wrtmailbox	;send it to the daemon
	popr	#^m<r3,r4,r5>
	blbc	r0,40$			;br to dealloc space if we fail
	movl	#pcb$m_nodelet,r9	;set what bit to alter (if any)
	movl	g^ctl$gl_pcb,r4		;get current pcb address
	bitl	#<pcb$m_nodelet>,pcb$l_sts(r4)	;is delete inhibited now?
	beql	67$			;if not set now, we may alter
	clrl	r9			;else leave alone
67$:	bisl	r9,pcb$l_sts(r4)	;inhibit process delete
					; across ipl0 interval
	clrl	4(r11)			; zero our wait cell so we do synch
; Wait for the AST to fire here.
	setipl ipl=#0,environ=UNIPROCESSOR
; Now we can issue a wait that a skast can interrupt.
; The victim process will hang around in LEF state till we get thru, so at
; least it will NOT busy wait.
65$:
	tstl	4(r11)		;done the wait?
	bneq	50$
	pushl	#31
	calls	#1,g^sys$clref	;clear efn 31
	tstl	4(r11)
	bneq	50$		;be sure wait still pending
	pushl	#31		;wait for ef 31
	calls	#1,g^sys$waitfr
	brb	65$
50$:
; now back to IPL2 to ensure no AST interruptions for what is left.
	setipl ipl=#2,environ=UNIPROCESSOR
	movl	g^ctl$gl_pcb,r4		;get current pcb address
	bicl	r9,pcb$l_sts(r4)	;enable delete if we were inhibiting it
;
; Now if there is a file ID returned at 284 off the start of the data block
; then put it into the user's FIB for the original I/O and clear the bits
; that specify extend should be done. Since we'll change the create to an
; open and open doesn't provide for extend, the extend needs to be done like
; the create by the daemon.
;
;msg.fib=52
;msg.rtnfid=120+264	;offset to returned FID from daemon
	movl	msg.fib(r11),r0		;user FIB address here
	tstl	msg.rtnfid(r11)		;any return FID exist?
	beql	52$			;if eql no, leave that alone
	movl	msg.rtnfid(r11),fib$w_fid(r0)	;else fill in the FID
	movw	msg.rtnfid+4(r11),fib$w_fid+4(r0);all 6 bytes of it...
	clrl	fib$l_exsz(r0)		;set no extend size needed
;also say not extending
	bicl	#fib$m_extend,fib$w_exctl(r0)
; now we can reuse R0, having extracted the return File ID
52$:
	movl	4(r11),r0		;if we got to daemon, flag ok
	brb	41$
40$:	movl	#1,r0		;let it go if mbx err
41$:	pushl	r0
;
; Get a new UCB if any
	movl	<120+264+16+100>(R11),R9	; R9 returns UCB if any
; get FID and DID also as 3 longs
	movl	<120+264+16+104>(R11),R6
	movl	<120+264+16+108>(R11),R7
	movl	<120+264+16+112>(R11),R8
; restore psl prev mode to what it should be to reissue user FDT codes
	evax_ldq	r16,116(r11)	;get the original PSL
	evax_wr_ps_sw			;write prev mode back again
	movl	r11,r0
	movl	#<120+264+16+116>,r1		;size
	jsb	g^exe$deanonpgdsiz	;free the msg block
	popl	r0
	popr	#^m<r1,r2,r3,r4,r5,r10,r11>
; Once back here, all registers are OK and the FDT loop
; should just continue where it left off.
; R9 returns with the new UCB to use...
	rsb
mfymount: $driver_fdt_entry
; stick processing in here if doing anything at io$_mount i/o time.
; for here, do nothing.
	movl	#1,r0
	bsbw	pors
	ret
;++
;
; JT_format - bash host disk tables to point at ours.
;
; With no function modifiers, this routine takes as arguments the name
; of the host disk (the real disk where the virtual disk will exist),
; the size of the virtual disk, and the LBN where the virtual disk
; will start. After these are set up, the device is put online and is
; software enabled.
;
; This routine does virtually no checking, so the parameters must be
; correct.
;
; Inputs:
;	p1 - pointer to buffer. The buffer has the following format:
;	     longword 0 - (was hlbn) - flag for function. 1 to bash
;			  the targetted disk, 2 to unbash it, else
;			  illegal.
;	     longword 1 - virtual disk length, the number of blocks in
;			  the virtual disk. If negative disables
;			  FDT chaining; otherwise ignored.
;	     longword 2 through the end of the buffer, the name of the
;			  virtual disk. This buffer must be blank
;			  padded if padding is necessary
;
;
;	p2 - size of the above buffer
;--
JT_format: $driver_fdt_entry
	.if	df,msetrp
; mousetrap trace cells
	movl	irp$l_func(r3),mtp$fmt(r5)	;save fcn code if we get here
	.endc	
	.if	ndf,evax
	bicw3	#io$m_fcode,irp$w_func(r3),r0	;mask off function code
	.iff
	bicw3	#io$m_fcode,irp$l_func(r3),r0	;mask off function code
	.endc
	bneq	20$			;branch if modifiers, special
;thus, normal io$_format will do nothing.
	brb	10$
; see if we even get here...
;	bsbw pors			;regular processing
;	ret
100$:
	popr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
10$:
	movzwl	#SS$_BADPARAM,r0	;illegal parameter
	clrl	r1
	call_abortio
;	ret
;	jmp	g^exe$abortio
20$:
	.if	ndf,evax
	movl	p1(ap),r0		;buffer address
	movl	p2(ap),r1		;length of buffer
	.iff
        movl    irp$l_qio_p1(r3),r0     ;buff address
        movl    irp$l_qio_p2(r3),r1     ;buff length
        .endc
	call_writechk
;	jsb	g^exe$writechk		;read access? doesn't return on error
;	clrl	irp$l_bcnt(r3)		;paranoia, don't need to do this...
	pushr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	.if	ndf,evax
	movl	p1(ap),r0		;get buffer address
	.iff
	movl	irp$l_qio_p1(r3),r0
	.endc
	movl	(r0)+,r7		;get option code
	bleq	100$			;0 or negative illegal
	cmpl	r7,#2			;3 and up illegal too
	bgtr	100$
	incl	chnflg
	movl	(r0)+,r6		;size of virtual disk (ignored)
	bleq	70$
	clrl	chnflg			;if 0 or neg. size don't chain...
70$:
	movab	(r0),-			;name of "real" disk
		ucb$l_JT_host_descr+4(r5)
	.if	ndf,evax
	subl3	#8,p2(ap),-		;set length of name in descriptor
		ucb$l_JT_host_descr(r5)
        .iff
        subl3   #8,irp$l_qio_p2(r3),-
                ucb$l_JT_host_descr(r5)
        .endc
	bleq	100$			;bad length
	movab	ucb$l_JT_host_descr(r5),r1	;descriptor for...
	jsb	g^ioc$searchdev		;search for host device
	blbs	r0,30$			;branch on success
; fail the associate...
	popr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	movzwl	#ss$_nosuchdev+2,r0	;make an error, usually a warning
	clrl	r1
	call_abortio
;	ret
;	jmp	g^exe$abortio		;exit with error
30$:	;found the device
; r1 is target ucb address...
; move it to r11 to be less volatile
	movl	r1,r11
	cmpl	r7,#1		;bashing the target UCB?
	bneq	31$
	jsb	mung		;go mung target...
	brb	32$
31$:
; Be sure we unmung the correct disk or we can really screw up a system.
	cmpl	r11,ucb$l_vict(r5)	;undoing right disk?
	bneq	32$			;if not skip out, do nothing.
	jsb	umung		;unmung target
32$:
;	bisw	#ucb$m_valid,ucb$w_sts(r5)	;set volume valid
;	bisw	#ucb$m_online,ucb$w_sts(r5)	;set unit online
;	movl	ucb$l_irp(r5),r3		;restore r3, neatness counts
	popr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	movzwl	#ss$_normal,r0			;success
	call_finishioc do_ret=yes
;	jmp	g^exe$finishioc			;wrap things up.
mung: .jsb_entry
; steal DDT from host. Assumes that the intercept UCB address
; is in R5 (that is, the UCB in which we will place the DDT copy),
; and that the UCB of the device whose DDT we are stealing is
; pointed to by R11. All registers are preserved explicitly so that
; surrounding code cannot be clobbered. R0 is returned as a status
; code so that if it returns with low bit clear, it means something
; went wrong so the bash did NOT occur. This generally means some other
; code that does not follow this standard has grabbed the DDT already.
; The following example assumes the code lives in a driver so the
; unique ID field and magic number are set already.
	tstl	ucb$l_mungd(r5)		;already munged/not deassigned?
	beql	6$
	rsb				;no dbl bash
6$:
        pushr   #^m<r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
; Acquire victim's fork lock to synchronize all this.
        movl    #ss$_normal,r0          ;assume success
        forklock ucb$b_flck(r11),-
	savipl=-(sp),preserve=YES
; find the current DDT address from the UCB (leaving the copy in
; the DDB alone)
        movl    ucb$l_ddt(r11),r10      ;point at victim's DDB
; fill in host ucb tbl (makes chnl handling faster)
	movab	jt_ucb,ucb$l_hucbs(r5)
	movl	ucb$l_hucbs(r5),r9	;get ucb table
	movzwl	ucb$w_unit(r5),r0	;get unit no.
	moval	(r9)[r0],r9		;point into tbl
	movl	r11,(r9)		;save target ucb addr in tbl
; see if this DDT is the same as the original
        movl    ucb$l_ddb(r11),r9       ;the ddb$l_ddt is the original
        cmpl    ddb$l_ddt(r9),r10       ;bashing driver the first time?
        beql    1$                      ;if eql yes
; driver was bashed already. Check that the current basher followed the
; standard. Then continue if it looks OK.
        cmpl    <ucb$l_icsign-ucb$a_vicddt>(r10),#p.magic
                                        ;does the magic pattern exist?
; if magic pattern is missing things are badly messed.
        beql    2$                      ;if eql looks like all's well
        movl    #2,r0                   ;say things failed
        brw     100$                    ;(brb might work too)
2$:
; set our new ddt address in the previous interceptor's slot
        movab   ucb$a_vicddt(r5),<ucb$l_intcddt-ucb$a_vicddt>(r10)
                                        ;store next-DDT address relative
                                        ;to the original victim one
1$:
	movl	#1,ucb$l_mungd(r5)	;say we munged jt
        movl    r10,ucb$l_prevddt(r5)   ;set previous DDT address up
        clrl    ucb$l_intcddt(r5)       ;clear intercepting DDT initially
3$:
        pushl   r5
; copy a little extra for good luck...
        movc3   #<ddt$k_length+12>,(r10),ucb$a_vicddt(r5)    ;copy the DDT
        popl    r5                      ;get UCB pointer back (movc3 bashes it)
;
; Here make whatever mods to the DDT you need to.
;
; FOR EXAMPLE make the following mods to the FDT pointer
; (These assume the standard proposed for FDT pointers)
        movab   ucb$a_vicddt(r5),r8     ;get a base register for the DDT
        movl    r5,JT_functable+fdt_prev    ;save old FDT ucb address
	movl	ddt$l_fdt(r10),ucb$l_oldfdt(r5)
        movl    ucb$l_uniqid(r5),JT_functable+fdt_idnt ;save unique ID also
; copy legal and buffered entry masks of original driver.
; HOWEVER, set mask for format entry to be nonbuffered here since
; we deal with it.
	pushr	#^m<r6,r7,r8,r9,r10,r11>
	movab	ucb$l_myfdt(r5),r9	;our function table dummy in UCB
	movl	ddt$l_fdt(r10),r7	;victim's FDT table
; We want all functions legal in the victim's FDT table to be legal
; here.
	pushr	#^m<r0,r1,r2,r3,r4,r5>	;preserve regs from movc
	.if	ndf,irp$q_qio_p1
	movl	#<68*4>,r0		;byte count of a step 2 FDT
	.iff
;note that a 64 bit FDT is 68 longs long. Get that plus a spare quadword
; for safety since we're stealing it all..
        movl    #<FDT$K_LENGTH+8>,r0    ;byte count of a step 2 FDT + slop
	.endc
	movc3	r0,(r7),(r9)		;copy his FDT to ours
	popr	#^m<r0,r1,r2,r3,r4,r5>	;preserve regs from movc
; Now copy in our modify & back-to-original FDT cells.
; We will do this in our FDT table by having FDT definitions only
; for those functions in JTdriver that we service locally. Thus
; all entry cells for the rest will point in the JT FDT to
; exe$illiofunc.
	movab	g^exe$illiofunc,r8	;get the magic address
	movab	jt_functable,r10	;r10 becomes JT FDT tbl
	addl2	#8,r10			;point at functions
	addl2	#8,r9			;his new FDT...
	movl	#64,r11			;64 functions
	.if	ndf,b$fmt$
	pushl	r7
	movab	jt_format,r7		; let victim's format fdt by
	.endc
75$:	cmpl	(r10),r8		;this function hadled in JT?
	beql	76$			;if eql no, skip
	.if	ndf,b$fmt$
	cmpl	(r10),r7		;this our io$_format
	beql	76$			;if so leave victim's alone
	.endc
	movl	(r10),(r9)		;if we do it point his fdt at our fcn
; (NOTE: our functions MUST therefore call the previous FDT's functions at
;  end of their processing.)
76$:	cmpl	(r10)+,(r9)+		;pass the entry
	sobgtr	r11,75$			;do all functions
	.if	ndf,b$fmt$
	popl	r7			;get back victim fdt
	.endc
; JTdriver FDT table. Last entry goes to user's original FDT chain.
;
; Thus we simply insert our FDT processing ahead of normal stuff, but
; all fcn msks & functions will work for any driver.
	popr	#^m<r6,r7,r8,r9,r10,r11>
; Now point the user's FDT at our bugger'd copy.
        movab	ucb$l_myfdt(r5),ddt$l_fdt(r8) ;point at our FDT table
        clrl    myonoff                 ;turn my FDTs on
;
; Finally clobber the victim device's DDT pointer to point to our new
; one.
	.iif df,evax,evax_imb
        movab   ucb$a_vicddt(r5),ucb$l_ddt(r11)
	.iif df,evax,evax_imb
; Now the DDT used for the victim device unit is that of our UCB
; and will invoke whatever special processing we need. This processing in
; the example here causes the intercept driver's FDT routines to be
; used ahead of whatever was in the original driver's FDTs. Because
; the DDT is modified using the UCB pointer only, target device units
; that have not been patched in this way continue to use their old
; DDTs and FDTs unaltered.
;
; Processing complete; release victim's fork lock
100$:
        forkunlock lock=ucb$b_flck(r11),newipl=(sp)+,-
         preserve=YES
        popr    #^m<r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	rsb
umung: .jsb_entry
;
; Entry: R11 points at victim device UCB and current driver is the one
; desiring to remove its entry from the DDT chain. Thus its xx$dpt: address
; is the one being sought. ("Current driver" here means the intercept
; driver.)
;   It is assumed that the driver knows that the DDT chain was patched
; so that its UCB contains an entry in the DDT chain
        pushr   #^m<r0,r1,r2,r3,r4,r5,r10,r11>
	movl	r11,r5			;hereafter use r5 as victim's UCB
        movl    ucb$l_ddt(r5),r10       ;get the DDT we currently have
        movl    ucb$l_ddb(r5),r1        ;get ddb of victim
        movl    ddb$l_ddt(r1),r1        ;and real original DDT
        movl    r10,r0                  ;save ucb$l_ddt addr for later
        movab   driver$dpt,r11              ;magic pattern is DPT addr.
;        movab   DPT$TAB,r11             ;magic pattern is DPT addr.
; lock this section with forklock so we can safely remove
; entries at fork also. Use victim device forklock.
        forklock lock=ucb$b_flck(r5),savipl=-(sp),preserve=YES
2$:     cmpl    <ucb$l_uniqid-ucb$a_vicddt>(r10),R11
                                        ;this our own driver?
        beql    1$                      ;if eql yes, end search
        .if     df,chk.err
        cmpl    <ucb$l_icsign-ucb$a_vicddt>(r10),#p.magic
        bneqw    4$                     ;exit if this is nonstd bash
        .endc   ;chk.err
; follow DDT block chain to next saved DDT.
        movl    <ucb$l_prevddt-ucb$a_vicddt>(r10),r10
                                        ;point R10 at the next DDT in the
                                        ;chain
        .if     df,chk.err
        bgeqw   4$                     ; (error check if not negative)
        .endc   ;chk.err
        brb     2$                      ;then check again
1$:
; At this point R10 contains the DDT address within the intercept
; driver's UCB. Return the address of the intercept driver's UCB next.
        tstl    <ucb$l_intcddt-ucb$a_vicddt>(r10)       ;were we intercepted?
        bgeq    3$                      ;if geq no, skip back-fixup
; we were intercepted. Fix up next guy in line.
        movl    <ucb$l_intcddt-ucb$a_vicddt>(r10),r11  ;point at interceptor
        movl    <ucb$l_prevddt-ucb$a_vicddt>(r10),<ucb$l_prevddt-ucb$a_vicddt>(r11)
3$:
; if we intercepted someone, fix up our intercepted victim to skip by
; us also.
        movl    <ucb$l_prevddt-ucb$a_vicddt>(r10),r2    ;did we intercept
                                        ;original driver?
        cmpl    r2,r1                   ;test if this is original
        beql    5$                      ;if eql yes, no bash
; replace previous intercept address by ours (which might be zero)
        movl    <ucb$l_intcddt-ucb$a_vicddt>(r10),<ucb$l_intcddt-ucb$a_vicddt>(r2)
5$:
; Here remove FDT entries from the list if they were modified.
; This needs a scan of the FDT chain starting at the victim's
; ddt$l_fdt pointer and skipping around any entry that has address
; JT_functable:
;  The FDT chain is singly linked. The code here assumes everybody
; plays by the same rules!
; NOTE: Omit this code if we didn't insert our FDT code in the chain!!!
        movl    ddt$l_fdt(r0),r1        ;start of FDT chain
        movab   JT_functable,r2         ;address of our FDT table
        clrl    r3
	movab	<0-ucb$a_vicddt>(r10),r4 ;initially point at our ucb
; Also set the JT device offline when we unbash it. This is a simple
; flag that ctl prog. can use to tell if it's been used already.
	.if	df,evax
	bicl	#<ucb$m_valid!ucb$m_online>,ucb$l_sts(r4)
	.iff
	bicw	#<ucb$m_valid!ucb$m_online>,ucb$w_sts(r4)
	.endc
6$:     cmpl    r1,r2                   ;current fdt point at us?
        beql    7$                      ;if eql yes, fix up chain
        movl    r1,r3                   ;else store last pointer
        movl    fdt_prev(r1),r4         ;and point at next
	bgeq	8$
	movl	ucb$l_oldfdt(r4),r1	;where last FDT pointer is in the ucb
;;;BUT not all UCBs will have the fdt offset at the same place!!!
;;;HOWEVER we will leave this in, putting the oldfdt field first after
;;;the regular UCB things.
        bgeq    8$                      ;if not sys addr, no messin'
        brb     6$                      ;look till we find one.
7$:
;r3 is 0 or fdt pointing to our block next
;r1 points at our fdt block
        tstl    r3                      ;if r3=0 nobody points at us
        bgeq    8$                      ;so nothing to do
	movl	fdt_prev(r1),r4
	bgeq	17$
	movl	ucb$l_oldfdt(r4),-(sp)	;save old fdt loc
	movl	fdt_prev(r3),r4
	blss	18$
	tstl	(sp)+
	brb	17$
18$:	movl	(sp)+,ucb$l_oldfdt(r4)
17$:    movl    fdt_prev(r1),fdt_prev(r3)  ;else point our next-fdt pointer at
                                        ;last fdt addr.
8$:
;
; Finally if the victim UCB DDT entry points at ours, make it point at
; our predecessor. If it points at a successor, we can leave it alone.
        cmpl    r10,r0                  ;does victim ucb point at our DDT?
        bneq    4$                      ;if not cannot replace it
        movl    <ucb$l_prevddt-ucb$a_vicddt>(r10),ucb$l_ddt(r5)
	clrl	<ucb$l_mungd-ucb$a_vicddt>(r10)	;zero jt munged flag
4$:
        forkunlock lock=ucb$b_flck(r5),newipl=(sp)+,preserve=YES
       popr    #^m<r0,r1,r2,r3,r4,r5,r10,r11>
                                        ;copy our prior DDT ptr to next one
	rsb

	.SBTTL	CONTROLLER INITIALIZATION ROUTINE
; ++
; 
; JT_ctrl_INIT - CONTROLLER INITIALIZATION ROUTINE
; 
; FUNCTIONAL DESCRIPTION:
; noop
; INPUTS:
; R4 - CSR ADDRESS
; R5 - IDB ADDRESS
; R6 - DDB ADDRESS
; R8 - CRB ADDRESS
; 
; 	THE OPERATING SYSTEM CALLS THIS ROUTINE:
; 		- AT SYSTEM STARTUP
; 		- DURING DRIVER LOADING
; 		- DURING RECOVERY FROM POWER FAILURE
; 	THE DRIVER CALLS THIS ROUTINE TO INIT AFTER AN NXM ERROR.
;--
JT_ctrl_INIT: $driver_ctrlinit_entry
;	CLRL	CRB$L_AUXSTRUC(R8)	; SAY NO AUX MEM
	movl	#1,r0
	Ret				;RETURN
	.SBTTL	INTERNAL CONTROLLER RE-INITIALIZATION
;
; INPUTS:
;	R4 => controller CSR (dummy)
;	R5 => UCB
;
	.SBTTL	UNIT INITIALIZATION ROUTINE
;++
; 
; JT_unit_INIT - UNIT INITIALIZATION ROUTINE
; 
; FUNCTIONAL DESCRIPTION:
; 
; 	THIS ROUTINE SETS THE JT: ONLINE.
; 
; 	THE OPERATING SYSTEM CALLS THIS ROUTINE:
; 		- AT SYSTEM STARTUP
; 		- DURING DRIVER LOADING
; 		- DURING RECOVERY FROM POWER FAILURE
; 
; INPUTS:
; 
; 	R4	- CSR ADDRESS (CONTROLLER STATUS REGISTER)
; 	R5	- UCB ADDRESS (UNIT CONTROL BLOCK)
;	R8	- CRB ADDRESS
; 
; OUTPUTS:
; 
; 	THE UNIT IS SET ONLINE.
; 	ALL GENERAL REGISTERS (R0-R15) ARE PRESERVED.
; 
;--

JT_unit_INIT: $driver_unitinit_entry
; Don't set unit online here. Priv'd task that assigns JT unit
; to a file does this to ensure only assigned JTn: get used.
;	BISW	#UCB$M_ONLINE,UCB$W_STS(R5)  ;SET UCB STATUS ONLINE
;limit size of JT: data buffers
JT_bufsiz=8192
	movl	#JT_bufsiz,ucb$l_maxbcnt(r5)	;limit transfers to 8k
	MOVB	#DC$_MISC,UCB$B_DEVCLASS(R5) ;SET DISK DEVICE CLASS
	clrl	ucb$l_mungd(r5)			;not mung'd yet
; NOTE: we may want to set this as something other than an RX class
; disk if MSCP is to use it. MSCP explicitly will NOT serve an
; RX type device. For now leave it in, but others can alter.
; (There's no GOOD reason to disable MSCP, but care!!!)
	movl	#^Xb22d4001,ucb$l_media_id(r5)	; set media id as JT
; (note the id might be wrong but is attempt to get it.) (used only for
; MSCP serving.)
	MOVB	#DT$_FD1,UCB$B_DEVTYPE(R5)  ;Make it foreign disk type 1
	movab	driver$dpt,ucb$l_uniqid(r5)
; (dt$_rp06 works but may confuse analyze/disk)
;;; NOTE: changed from fd1 type so MSCP will know it's a local disk and
;;; attempt no weird jiggery-pokery with the JT: device.
; MSCP may still refuse to do a foreign drive too; jiggery-pokery later
; to test if there's occasion to do so.
; Set up crc polynomial
	movab	jt_utb,ucb$l_hucbs(r5)	;host ucb table
;$def	ucb$l_ktrln	.blkl	1
;$def	ucb$l_k2tnm	.blkl	1
	movab	kast_code,ucb$l_ktrln(r5)	;set up kast pointers
	movab	kast_code_2,ucb$l_k2tnm(r5)
	.if	df,j$$vdsk	;normally not defined
	movl	r5,ucb$l_backlk(r5)	;backlink UCB initially our own
; Set up to point the JT unit DDT at its own UCB initially.
	fork		;ensure allocation's ok
	pushr	#^m<r0,r1,r2,r3,r4,r5,r6,r7>	;save regs from movc etc.
; Move our DDT into our UCB and point ucb$l_ddt there so when we go a-hunting
; for it, we find it where we do our own virtual disk.
	movl	ucb$l_ddt(r5),r6	;where our ddt now is
	movab	ucb$a_vicddt(r5),r7	;where we'll copy it
	movc3	#ddt$k_length,(r6),(r7)	;copy our DDT
	popr	#^m<r0,r1,r2,r3,r4,r5,r6,r7>	;get back regs so we can
						;find our UCB again.
	movab	ucb$a_vicddt(r5),ucb$l_ddt(r5)	;point UCB DDT pointer at copy
	.endc
	clrl	chnflg		;initially set to use our chain of FDTs
; Allocate process vector here.
	pushr	#^m<r0,r1,r2,r3>
	movl	g^sch$gl_maxpix,r1
	ashl	#5,r1,r1		;get 32 bytes per process
; link to LDT
; ccb addr
; proc. counter of enable/disable deletion
; finish count for our thread, bumped before we do i/o, decremented when
;	user's i/o r0 return avail.
;
pv.ldt=0
pv.ccb=4
pv.eds=8
pv.fin=12
	pushl	r1
	jsb	g^exe$alonpagvar	;get some pool
	popl	r1
	blbc	r0,5$
	zapz	(r2),r1			;zero it all initially
	movl	r2,ucb$l_prcvec(r5)	;set initial pointer in UCB
; now grab filenum bitmap store
	.if	ndf,wd.lst
	.iif	ndf,f.nsiz,f.nsiz=2048
	clrl	ucb$l_fnums(r5)
	movl	#f.nsiz,r1		;bytes to get
	jsb	g^exe$alonpagvar	;get some pool
	blbc	r0,31$
	movl	r2,ucb$l_fnums(r5)
	zapz	(r2),r1
31$:
	.endc
	popr	#^m<r0,r1,r2,r3>
	movl	#1,r0
	RET				;RETURN 
5$:
	popr	#^m<r0,r1,r2,r3>
	BICL	#UCB$M_ONLINE,UCB$L_STS(R5)  ;SET UCB STATUS OFFLINE
	movl	#1,r0
	ret
;
; findldt
; call with r5 = jt ucb cell, r6=ccb, r4=pcb
; Returns pointer to LDT in R0
; r0=0 if none exists. returns r1 = address to link ldt to if r0=0
; if r1 = 0 on return also, seriously bogus state like no 
; prcvec table.
; call at device ipl.
;
; slot has 
;  pointer to LDT chain
;  PID of owner process (in case it exits w/o cleanup)
findldt: .jsb_entry output=<r0,r1>
	pushr	#^M<r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	movl	g^ctl$gl_pcb,r4
	clrl	r0	;initially nothing
	movl	ucb$l_prcvec(r5),r1	;start of ldt chain
	bgeq	999$		;lose if none
	movzwl	pcb$l_pid(r4),r2	;get index
	ashl	#5,r2,r2		;get tbl entry offset
; shift 5 so 32 bytes = 8 longs per entry
	addl3	r2,r1,r3		;point r3 at our slot
	movl	r3,r1			;let r1 return as link addr
	tstl	4(r1)			;empty slot?
	bneq	3$
	clrl	(r1)			;if slot is empty clr ldt area
	brb	5$
3$:	cmpl	4(r1),pcb$l_pid(r4)	;right pid?
	beql	5$
	jsb	freslot			;wrong so free all ldt's
	clrl	(r1)
5$:	movl	pcb$l_pid(r4),4(r1)	;claim slot now
10$:	tstl	r1			;ensure pointer ok
	bgeq	999$
; check right process.
	movl	ldt$l_fwd(r1),r11	;get candidate ldt
	bgeq	999$			;if null, none to find, but R1 pointer ok
	cmpl	ldt$l_ccb(r11),r6	;got right ccb?
	beql	800$			;if we have it, branch
	movl	r11,r1			;else loop to next
	brb	10$			;and retry
800$:	movl	r11,r0			;return ldt addr in r0
999$:
; Callers may test r0=0 or r1=0. If they're +, return 0 since that's
; also an error.
	tstl	r1
	blss	997$
	clrl	r1
997$:	tstl	r0
	blss	996$
	clrl	r0	;return 0 instead of any positive values
996$:
	.iif df,msetrp, movl r1,mtp$r1+4(r5)
	popr	#^M<r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	rsb
; entry: r1=proc slot
freslot: .jsb_entry	;free entire slot, deallocating any LDTs.
	pushr	#^M<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	movl	r1,r11		;slot address
	bgeq	55$
	movl	(r1),r10	;start LDT if any
10$:	tstl	r10
	bgeq	50$
	movl	ldt$l_fwd(r10),r9	;grab pointer to next ldt if any
	movl	ldt$l_fresiz(r10),r1	;size to free
	cmpl    r1,#<ldt$k_clrsiz+512>
	bgtru	50$
	movl	r10,r0			;free this ldt
	bgeq    50$
	jsb	g^exe$deanonpgdsiz
	movl	r9,r10
	brb	10$		;keep looking
50$:
	zapz	(r11),#32	;zero all 32 bytes
55$:
	popr	#^M<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	rsb
; If this is the LAST LDT, just to be safe, clear paranoid mode.
; r5 is jt ucb now, R11 is LDT address
;	jsb	chklast			;check for last LDT
chklast: .jsb_entry
	pushr	#^M<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	movl	g^ctl$gl_pcb,r4
	clrl	r0	;initially nothing
	movl	ucb$l_prcvec(r5),r1	;start of ldt chain
	bgeq	999$		;lose if none
	movzwl	pcb$l_pid(r4),r2	;get index
	ashl	#5,r2,r2		;get tbl entry offset
; shift 5 so 32 bytes = 8 longs per entry
	addl3	r2,r1,r3		;point r3 at our slot
	movl	r3,r1			;let r1 return as link addr
	cmpl	(r1),r11		;Is this the last LDT about
					;to be freed??
	bneq	999$			;if not skip last ldt paranoia clean
; Clean up the paranoia stuff in the slot.
	clrl	<<6-2>*4>(r1)		;Clear counters that represent paranoia
	clrl	<<7-2>*4>(r1)		;mode
999$:

	popr	#^M<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	rsb
	.SBTTL	Other FDT ROUTINES 
	.if	df,lp$filt
; The RWFilt routine is present when assembled in, and has the purpose
; of preventing many user apps from bypassing the filesystem even if
; the user has log_io privs. It won't allow logical i/o from a user
; mode channel if the disk is mounted non-/foreign so that apps that
; can read ODS-2, for example, cannot bypass the filesystem and hence
; the checks here. More privileged channels are left alone.
;
RWFilt: $driver_fdt_entry
; be sure not a knl channel
	tstl	r6		;is there a CCB (must be +)
	bleq	2$		;if not skip out
	cmpb	ccb$b_amod(r6),#4	;user mode? If not ignore here
	bgeq	1$
2$:	bsbw pors	;leave knl mode chnls alone! (also exec, super)
	ret
1$:
; If both pcb$m_nounshelve and pcb$m_shelving_Reserved bits are
; set in PCB, omit the filtering.
	.if	df,pcbmsk$$
; if reserved shelving bit is clear we filter as usual
	bbc	#pcb$v_shelving_reserved,pcb$l_sts2(r4),502$
; if and only if both bits are set we skip out
	bbs	#pcb$v_nounshelve,pcb$l_sts2(r4),2$
502$:
	.endc
	pushr	#^m<r0,r5>
; original r5 now at 4(sp). Must get that to continue the ops.
	jsb	getJTucb		;find JTdriver ucb
	tstl	r0
	blss	509$
1509$:
	popr	#^m<r0,r5>
	bsbw	popout
	ret
509$:
;	bgeqw	popout
	movl	r5,ucb$l_backlk(r0)	;save link'd ucb in ours too.
	movl	r0,r5			;point R5 at JT UCB
	bitl	#1048576,ucb$l_ctlflgs(r5)	;look at r/w logical?
	beqlw	1509$			;if not skip
; Make sure this isn't one of OUR daemons
	cmpl	pcb$l_pid(r4),ucb$l_daemon(r5)	;open etc. daemon?
	beqlw	1509$
	cmpl	pcb$l_pid(r4),ucb$l_exdmn(r5)	;not extend daemon
	beqlw	1509$
	cmpl	pcb$l_pid(r4),ucb$l_deldmn(r5)
	beqlw	1509$			;not delete daemon
	cmpl	pcb$l_pid(r4),ucb$l_exempt(r5)	;exempted pid?
	beqlw	1509$
	cmpl	pcb$l_pid(r4),ucb$l_exempt+4(r5) ;exempted pid?
	beqlw	1509$
	cmpl	pcb$l_pid(r4),ucb$l_exempt+8(r5) ;exempted pid?
	beqlw	1509$
	cmpl	pcb$l_pid(r4),ucb$l_exempt+12(r5) ;exempted pid?
	beqlw	1509$
;make sure that if it's a knl,exec,or super chnl we leave it alone
	cmpb	ccb$b_amod(r6),#4	;this chnl to be left alone?
	blss	1509$			; if so scram NOW.
	bitl	#dev$m_mnt,ucb$l_devchar(r5)	;mounted at all?
	beql	1509$			;if not mounted, r/w log. OK
	bitl	#dev$m_for,ucb$l_devchar(r5)	;foreign mount?
	beql	1509$
; disallow the request...device is mounted, not /foreign and channel is
; user mode.
	popr	#^m<r0,r5>
	MOVZWL	#SS$_devmount,R0	;No logical I/O to mounted disk
; (privilege or no!)
	call_abortio			; abort the i/o
	ret
	.endc
;++
; 
; JT_ALIGN - FDT ROUTINE TO TEST XFER BYTE COUNT
; 
; FUNCTIONAL DESCRIPTION:
; 
; 	THIS ROUTINE IS CALLED FROM THE FUNCTION DECISION TABLE DISPATCHER
; 	TO CHECK THE BYTE COUNT PARAMETER SPECIFIED BY THE USER PROCESS
; 	FOR AN EVEN NUMBER OF BYTES (WORD BOUNDARY).
; 
; INPUTS:
; 
; 	R3	- IRP ADDRESS (I/O REQUEST PACKET)
; 	R4	- PCB ADDRESS (PROCESS CONTROL BLOCK)
; 	R5	- UCB ADDRESS (UNIT CONTROL BLOCK)
; 	R6	- CCB ADDRESS (CHANNEL CONTROL BLOCK)
; 	R7	- BIT NUMBER OF THE I/O FUNCTION CODE
; 	R8	- ADDRESS OF FDT TABLE ENTRY FOR THIS ROUTINE
; 	4(AP)	- ADDRESS OF FIRST FUNCTION DEPENDENT QIO PARAMETER
; 
; OUTPUTS:
; 
; 	IF THE QIO BYTE COUNT PARAMETER IS ODD, THE I/O OPERATION IS
; 	TERMINATED WITH AN ERROR. IF IT IS EVEN, CONTROL IS RETURNED
; 	TO THE FDT DISPATCHER.
; 
;--
nolchk=0
JT_ALIGN: .jsb_entry	;CHECK BYTE COUNT AT P1(AP)
;	BLBS	4(AP),10$		;IF LBS - ODD BYTE COUNT
	movl	#1,r0
	RSB				;EVEN - RETURN TO CALLER

	.SBTTL	START I/O ROUTINE
;++
; 
; JT_STARTIO - START I/O ROUTINE
; 
; FUNCTIONAL DESCRIPTION:
; 
; 	THIS FORK PROCESS IS ENTERED FROM THE EXECUTIVE AFTER AN I/O REQUEST
; 	PACKET HAS BEEN DEQUEUED.
; 
; INPUTS:
; 
; 	R3		- IRP ADDRESS (I/O REQUEST PACKET)
; 	R5		- UCB ADDRESS (UNIT CONTROL BLOCK)
; 	IRP$L_MEDIA	- PARAMETER LONGWORD (LOGICAL BLOCK NUMBER)
; 
; OUTPUTS:
; 
; 	R0	- FIRST I/O STATUS LONGWORD: STATUS CODE & BYTES XFERED
; 	R1	- SECOND I/O STATUS LONGWORD: 0 FOR DISKS
; 
; 	THE I/O FUNCTION IS EXECUTED.
; 
; 	ALL REGISTERS EXCEPT R0-R4 ARE PRESERVED.
; 
;--
JT_STARTIO: $driver_start_entry
; 
; 	PREPROCESS UCB FIELDS
; 
;	ASSUME	RY_EXTENDED_STATUS_LENGTH  EQ  8
;	CLRQ	UCB$Q_JT_EXTENDED_STATUS(R5)	; Zero READ ERROR REGISTER area.
; 
; 	BRANCH TO FUNCTION EXECUTION
	bbs	#ucb$v_online,-	; if online set software valid
		ucb$l_sts(r5),210$
216$:	movzwl	#ss$_volinv,r0	; else set volume invalid
	brw	resetxfr	; reset byte count & exit
210$:
; Unless we use this entry, we want to junk any calls here.
	brb	216$		;just always say invalid volume.

; Get here for other start-io entries if the virtual disk code is
; commented out also, as it must be.
;FATALERR:				;UNRECOVERABLE ERROR
;	MOVZWL	#SS$_DRVERR,R0		;ASSUME DRIVE ERROR STATUS

RESETXFR:	; dummy entry ... should never really get here
	MOVL	UCB$L_IRP(R5),R3	;GET I/O PKT
;	MNEGW	IRP$W_BCNT(R3),UCB$W_BCR(R5) ; RESET BYTECOUNT
;	BRW	FUNCXT
FUNCXT:					;FUNCTION EXIT
	CLRL	R1			;CLEAR 2ND LONGWORD OF IOSB
	REQCOM,environment=call		; COMPLETE REQUEST
; 
;PWRFAIL:				;POWER FAILURE
;	BICW	#UCB$M_POWER,UCB$W_STS(R5)  ;CLEAR POWER FAILURE BIT
;	MOVL	UCB$L_IRP(R5),R3	;GET ADDRESS OF I/O PACKET
;	MOVQ	IRP$L_SVAPTE(R3),-	;RESTORE TRANSFER PARAMETERS
;		UCB$L_SVAPTE(R5)	;...
;	BRW	JT_STARTIO		;START REQUEST OVER
;JT_INT::
;JT_UNSOLNT::
;	POPR	#^M<R0,R1,R2,R3,R4,R5>
;	REI	;DUMMY RETURN FROM ANY INTERRUPT
	;;
;Note that the "step2" stuff is a special kernel AST so the call
; convention is JSB type regardless...
jtkast: .jsb_entry
; special knl AST entry daemon should cause.
	pushr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	movl	acb$l_astprm(r5),r11	;get LDT address
	movl	r5,r0		;dealloc. the acb
	movl	#acb$c_length,r1	;length used
	jsb	g^exe$deanonpgdsiz
; get ucb pointer back
	evax_ldq r5,ldt$l_regs+24(r11)
;	movl	ldt$l_regs+24(r11),r5	;get victim dvc ucb
	jsb	getjtucb		;find JT UCB now
	tstl	r0
	bgeq	12$
	movl	r0,r5			;point at jt ucb now
12$:
	movl	r11,(sp)		; set return of r11 in r0
	movl	r5,4(sp)		; r5 returns in r1
	popr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>	
	bsbw	lclcnt			;go continue "step2" ast
	rsb

; step 1.5 entry. Normal kernel AST here from our $qio. We take it and
; build a special kernel AST instead.
	.entry	vcstp15,^m<r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
prm=4
	movl	prm(ap),r11	;get LDT address back to familiar R11
;grab an ACB for skast
	movl	#<acb$c_length>,r1	;size of an acb
	jsb	g^exe$alonpagvar	;allocate space for acb
	blbc	r0,999$			;if we fail, lose
	zapz	(r2),#<acb$c_length>	;zero the ACB initially
	movw	r1,acb$w_size(r2)	;save size
	movl	r11,acb$l_astprm(r2)	;ldt is AST parameter again
	movl	r2,r5			;sch$qast wants r5 to have acb
	.if	df,msetrp
	pushl	r10
	movl	ldt$l_jtucb(r11),r10	;get jt ucb
	movl	#20,mtp$trace(r10)
	popl	r10
	.endc
	movl	g^ctl$gl_pcb,r4		;point at our PCB just in case
;	.if	df,evax
;	decl	pcb$l_astcnt(r4)	;count down ast quota for this one
;	.iff
;	adawi	#-1,pcb$w_astcnt(r4)
;	.endc
	movab	vcstep2,acb$l_kast(r5)	;goto vcstep2...
	movl	pcb$l_pid(r4),acb$l_pid(r5)	;in this process
	clrl	acb$l_ast(r5)		;set no ast
	movb	#<1@acb$v_kast>,acb$b_rmod(r5)	;set skast mode
	movl	#3,r2			;prio boost of 3 (random...)
	jsb	g^sch$qast		;requeue the acb
999$:	movl	#31,-(sp)		;set junk efn now
	calls	#1,g^sys$setef		;
	movl	#1,r0			;normal status
	ret				;back to whatever now


; "step 2" entry. HERE we have (hopefully) the ACL read in and must now
; decode it. Also we need to see if we need to call the daemon and do so if
; this is appropriate.
; Note stp2bad is a very unusual path...
stp2bad: .jsb_entry
	pushr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	movl	r0,r11	;r11 now points at LDT
	pushl	r0
	movl	#31,-(sp)		;set junk efn now
	calls	#1,g^sys$setef		;
	popl	r0
	brw	v2cmn	;go join common code to try & issue user's I/O
vcstep2: .jsb_entry
	pushr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	movl	#31,-(sp)		;set junk efn now
	calls	#1,g^sys$setef		;
	movl	acb$l_astprm(r5),r11	; get LDT addr
;now free the ACB
	pushr	#^m<r0,r1,r2,r3,r4,r5,r11>
	movl	r5,r0			;address
	movl	#acb$c_length,r1	;size
	jsb	g^exe$deanonpgdsiz
	popr	#^m<r0,r1,r2,r3,r4,r5,r11>
v2cmn:	tstl	r11			;ensure LDT is good
	blss	vcz			;if good, it's neg. addr
vcx:	popr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	rsb				;else give up.
vcz:
; Now get original IRP, UCB, etc. to registers so we can work normally.
	.if	df,msetrp
	pushl	r10
	movl	ldt$l_jtucb(r11),r10	;get jt ucb
	movl	#21,mtp$trace(r10)
	popl	r10
	.endc
;	movl	ldt$l_regs+8(r11),r3	;get original R3
;	movl	ldt$l_regs+24(r11),r5	;and real device R5
	evax_ldq r3,ldt$l_regs+8(r11)
	evax_ldq r5,ldt$l_regs+24(r11)
	jsb	getjtucb		;go find JT UCB address
	tstl	r0			;got it?
	beql	vcx			;if not give up.
	movl	r0,r5			;R5 is now JT UCB addr
	.iif	df,msetrp,movl #22,mtp$trace(r5)
	movab	ldt$l_acl(r11),r9	;now point at the ACL we read
; For cases where IO$M_CREATE is set and the user wants NT fakery (100000 hex
; set in ctlflgs) we will send a message to the daemon also, and add a
; little flag so it can tell this happened. This means we look at the
; IOSB and see if the file did not exist too...
	BITL	#^x100000,ucb$l_ctlflgs(r5)	;w/o dir fakery wanted?
	beql	704$
	bitl	#^x200000,ucb$l_ctlflgs(r5)	;use proc. structure?
	beql	705$			; if so skip test
;
; look in process struct to see if we need to send msg
        movl    ucb$l_prcvec(r5),r10;start of ldt chain
        bgeq    704$              ;lose if none
        movzwl  pcb$l_pid(r4),r1        ;get index
        ashl    #5,r1,r1                ;get tbl entry offset
; shift 5 so 32 bytes = 8 longs per entry
        addl2   r1,r0                   ;point at our syruct
        addl2   #pv.pid,r0              ;point at our pid
        cmpl    (r0),pcb$l_pid(r4)      ;our PID doing this?
        bneq    704$                    ;no, skip NT-special stuff
705$:

; Now check that this DID is one we want to consider...if indeed it is.
	.if	ndf,evax
	movl	p1(ap),r0	;get fib
	.iff
	movl	irp$l_qio_p1(r3),r0
	.endc
	ifnord #4,4(r0),2551$
	movl	4(r0),r0	;...from descriptor
	beql	2551$		;fib addr can't be 0
; FIB is now pointed to by R0, so hunt up the filenumber part of the
; DID and see if it is one we care about.
	movzwl	fib$w_did(r0),r0	;get the DID file number
	beql	704$		; zero is probably junk
	bicl	#^c<didnum-1>,r0	;mask to bitmap size
	cmpzv	r0,#1,ucb$a_dirbmp(r5),#0	;test that bit
	beql	704$		; if bit is 0, skip daemon processing
2551$:

; Need to handle non existent file case. We do this minimally here
; (undoing LDT alloc etc. is complex enough)
; by checking the IOSB
	cmpw	ldt$l_myiosb(R11),#ss$_NOSUCHFILE	;no file there?
	bneq	704$			;if not, won't create a new one
	bitl	#io$m_create,irp$l_func(r3)	;did user spec create?
	beql	704$			;if eql no, normal op
; No file there and user said create a file. Arrange to send the file
; info for NT type parse.
	brw	ffid2			;go send the message with fake file id
					;(5,0,0)
704$:
	tstl	(r9)			;whole ACL null? (shortcut)
	beqlw	15$			;if so skip everything.
	.iif	df,msetrp,movl #23,mtp$trace(r5)
; acl in r9
; get ACL size
	movl	ldt$l_aclsiz(r11),r10	;pass ACL size in R10
	beqlw	15$			;sanity check again
; Hunt up our ACE if possible & store in LDT
	addl3	#512,r9,r8		;r8 is end address
7$:	movzbl	(r9),r7			;get length
	beqlw	15$			;if 0, skip
	cmpl	r9,r8			;past end?
	bgequ	dnfid			;if so branch
	cmpb	1(r9),#ace$c_info	;application ACL?
	beql	8$			;if so, see if ours.
9$:	addl2	r7,r9
	brb	7$			;else keep looking
8$:	cmpl	8(r9),acllit		;see if it's mine...
	bneq	9$			;if neq skip
; aha...found OUR ACE.
; Fill in LDT
	.iif	df,msetrp,movl #24,mtp$trace(r5)
	pushr	#^m<r0,r1,r2,r3,r4,r5>
	movab	ldt$l_ace(r11),r0	;copy the ACE in
	movc3	r7,(r9),(r0)		;one fell swoop
	popr	#^m<r0,r1,r2,r3,r4,r5>
	brw	dnfid			;if an ACE was there, don't fake one
; Check for our file number cache here and FAKE an ACE if none was seen.
; (Note we might still have an ACE in a too-long ACL; daemon must test that.)
15$:	movab	ldt$l_fib(r11),r7	;point at our fib
	.iif	df,msetrp,movl #25,mtp$trace(r5)
	bitl	#32768,ucb$l_ctlflgs(r5) ;pretend ACE is there always?
	bneq	fakfd4			; if bit is set, do so. Use if disk
					; has almost all files marked...
; If checking open files count is >0 we also fake access
	movl	ldt$l_prcstr(r11),r7	;get the proc structure
	bgeq	5503$			;if it exiss...
	tstl	<<6-2>*4>(r7)		;is the opnchk count +
	bgtr	fakfid2
	tstl	<<7-2>*4>(r7)		;also if runchk set do it
	bgtr	fakfid2			;(acctl has bits set)
5503$:
	movab	ldt$l_fib(r11),r7	;point at our fib
	movzwl	fib$w_fid(r7),r7	;this file number
	.if	df,wd.lst
	movl	#f.nums,r10		;number of filenumbers
	movab	ucb$l_fnums(r5),r9	;store of 16 bit file numbers
11$:	cmpw	(r9)+,r7		;got our file number?
	beql	fakfid			;if so gen. an ACE
	sobgtr	r10,11$			;check all
	.iff
	movl	ucb$l_fnums(r5),r9	; address of storage
	beql	dnfdj
	bicl	#f.mask,r7		; clear extra bits
	ashl	#-3,r7,r10		; isolate bit number
	addl2	r9,r10			;address to R10
	bicl	#-8,r7			; get bit #
	bbs	r7,(r10),fakfid		; and test if, gen ace if a 1
	.endc
dnfdj:	brw	dnfid			;if we see none, continue normally
ffid2:
	movab	ldt$l_ace(r11),r10	;else gen. our ACE
	movb	#13,(r10)+		;ace length
	movb	#ace$c_info,(r10)+	;info flags
	movw	#^xe01,(r10)+		;other flags (hidden, prot, dmn)
	movl	#1,(r10)+		;call daemon
	movl	acllit,(r10)+		;flag OUR ACE
	movb	#1,(r10)+		;and insert an "inspectme" record
	movab	ldt$l_fib(r11),r7	;point at our fib
	movl	#5,ldt$l_myfid(r11)	;set fake file id
	clrl	ldt$l_myfid+4(r11)	;of longs 5,0
	movl	#7,ldt$l_aclsiz(r11)	;fill fake acl size in too
; copy the user FIB also, so we'll have it handy. Store it in the
; user ACE area since we need only 72 bytes.
; This is for cases where a new file has to be created!
	movab	ldt$l_ace(r11),r10	;else gen. our ACE
	addl2	#40,R10			;Start at offset 40 (past what
					;we just generated
	pushr	#^m<r0,r1,r2,r3,r4,r5>
	movl	#fib$k_length,R0
	movc3	r0,(r7),(r10)		;copy the user FIB
	popr	#^m<r0,r1,r2,r3,r4,r5>
	brw	dnfd2

fakfid2:
        tstl    <<6-2>*4>(r7)
        bleq    fakfd3
        bisl    #ldt$m_opnchk,ldt$l_accmd(r11)
fakfd3:
        tstl    <<7-2>*4>(r7)               ;bump runfcn count
        bleq    fakfd4
        bisl    #ldt$m_runfcn,ldt$l_accmd(r11)
fakfd4:	movab	ldt$l_ace(r11),r10	;else gen. our ACE
	movb	#13,(r10)+		;ace length
	movb	#ace$c_info,(r10)+	;info flags
	movw	#^xe01,(r10)+		;other flags (hidden, prot, dmn)
	movl	#^x8000001,(r10)+	;call daemon, but add "faked" flag
					;of 8000000 hex
	movl	acllit,(r10)+		;flag OUR ACE
	movb	#1,(r10)+		;and insert an "inspectme" record
	brb	dnfid
fakfid:	movab	ldt$l_ace(r11),r10	;else gen. our ACE
	movb	#13,(r10)+		;ace length
	movb	#ace$c_info,(r10)+	;info flags
	movw	#^xe01,(r10)+		;other flags (hidden, prot, dmn)
; Also flag where we should have, but did not, find the ACE here.
	movl	#^x8000011,(r10)+	;call daemon, but add "faked" flag
					;of 8000000 hex
	movl	acllit,(r10)+		;flag OUR ACE
	movb	#1,(r10)+		;and insert an "inspectme" record
; Rest will be 0 from initial zapz call of mem. in LDT on alloc.
dnfid:
10$:	
; See if the I/O we finished failed completely and if so forget about
; calling the daemon...
	movl	ldt$l_synch(r11),r7	;get synch block address
	bgeq	12$			;if illegal forget it
	tstw	8(r7)			;check the IOSB return
	bgeq	12$
	movl	#8,ldt$l_rtnsts(r11)	;set failure status
	brb	30$			;if negative just continue on
12$:
; Save the file ID from our FIB for possible daemon use.
	.iif	df,msetrp,movl #26,mtp$trace(r5)
	movab	ldt$l_fib(r11),r7	;point at our fib
	movl	fib$w_fid(r7),ldt$l_myfid(r11)
	movl	fib$w_fid+4(r7),ldt$l_myfid+4(r11)
30$:
	movl	r11,(sp)		;need clean stack, r11=ldt in r0
	movl	r5,4(sp)		;r1 gets r5
	popr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	bsbw	lclcnt			;helper branch
	rsb
dnfd2:
; Flag for the daemon if the ACL was too darn long.
	cmpl	ldt$l_aclsiz(r11),#512	;was acl too long?
	bleq	15$			;if leq, no
; long ACL. If no ACE now, go hunt.
	tstb	ldt$l_ace(r11)		;ace still null?
	bneq	15$			;if not, leave alone
	movl	ldt$l_aclsiz(r11),ldt$l_ace(r11)	;else save len
	movl	#<<8*65536>+1>,ldt$l_ace+4(r11)	;and save magic # as flag
15$:
; Now see if we need to call the daemon. If so, best go and do it,
; getting back via SKAST. Afterwards, do any priv or ID mods or
; other alteration if user I/O is to go on; otherwise just do bogus
; good/bad finish.
	.iif	df,msetrp,movl #27,mtp$trace(r5)
	movl	#1,ldt$l_rtnsts(r11)	;set return stat initially ok
	movab	ldt$l_ace(r11),r10	;point at our ACE
	bitl	#1,4(r10)		;1 bit means call daemon
	beqlw	30$			;if eql no daemon call.
; Need to call daemon. Do mailbox thing like fqdriver, after test that
; daemon exists.
	.iif	df,msetrp,movl #27,mtp$trace(r5)
	movl	ucb$l_mbxucb(r5),r9	;mailbox ucb here
	bgeqw	30$
	.iif	df,msetrp,movl #28,mtp$trace(r5)
	bitl	#ucb$m_online,ucb$l_sts(r9)	;is mbx online?
	beqlw	30$			;if not, just issue i/o
	.iif	df,msetrp,movl #29,mtp$trace(r5)
	.if	df,evax
	tstl	ucb$l_refc(r9)		;someone listening?
	.iff
	tstw	ucb$w_refc(r9)		;someone listening?
	.endc
	bleqw	30$			;if leq no
	tstl	ucb$l_orb(r9)		;someone own it (daemon)?
	bgeqw	30$			;if geq no
	.iif	df,msetrp,movl #30,mtp$trace(r5)
;check daemon pid still valid
        pushr  #^m<r5,r6,r7,r8>
        movzwl  g^sch$gl_maxpix,r7      ;max process index in VMS
22$:
        movl    g^sch$gl_pcbvec,r6      ;get pcb vector address
        movl    (r6)[r7],r8             ;get a PCB address
        tstl    r8              ;system address should be < 0
        bgeq    23$                     ;if it seems not to be a pcb forget it
        cmpl    ucb$l_daemon(r5),pcb$l_pid(r8)  ;this our process?
        beql    21$                    ;if so, jump out of loop
23$:    sobgtr  r7,22$                  ;if not, look at next
        clrl    ucb$l_daemon(r5)        ;if cannot find process, zero our flag
21$:
        popr   #^m<r5,r6,r7,r8>
	.iif	df,msetrp,movl #31,mtp$trace(r5)
        tstl    ucb$l_daemon(r5)        ;got our daemon process there?
	beqlw	30$			;if not, skip
; Looks OK to send a buffer to the daemon. Grab one and send the message,
; Save and send the filename too.
opnbfsz=96+512+8
; 96 bytes was v2 size. Copy the filename beyond that.
	subl	#OpnBfSz,sp		;get buffer on stack
	movl	sp,r8			;r8 points at it now
	movl	r11,(r8)		;pass LDT
	movl	r5,4(r8)		;pass UCB of JT dvc
	movl	ucb$l_backlk(r5),8(r8)	;and original dvc UCB (needed...)
	movl	r10,12(r8)		;point at our ACE
	movab	jtkast,16(r8)		;point at where to send SKAST
	movl	ldt$l_myfid(r11),20(r8)	;pass file id too
	movzwl	ldt$l_myfid+4(r11),24(r8) ;all of it...
	movl	ldt$l_accmd(r11),28(r8)	;send how-open info
; We'll need the original directory ID if we have to create a file
; for here! If we do, we need to reset the FIB and so forth to
; point at it.
	movl	ldt$l_mydid(r11),32(r8)	;also directory ID
	movzwl	ldt$l_mydid+4(r11),36(r8) ;all of it
; Reason for sending this stuff is that it's harder to retrieve it
; from another proc. context in the daemon.
	movl	g^ctl$gl_pcb,40(r8)	;send pcb
	movl	g^ctl$gl_pcb,r4
	movl	pcb$l_pid(r4),44(r8)	;& pid so we can send an ast
	movl	pcb$l_epid(r4),48(r8)	;& pid so we can send an ast
	movl	r5,52(r8)		;ucb of JT device
; Now follow ucb$l_ddb to get device name, unit, allocls and
; nodename.
	pushr	#^m<r0,r1,r2>
	movl	ucb$l_backlk(r5),r0	;get device ucb of victim
	movzwl	ucb$w_unit(r0),56(r8)	;send unit number
	movl	ucb$l_ddb(r0),r1	;get DDB (name is there)
	movl	ddb$l_allocls(r1),84(r8) ;save alloc class
	clrl	60(r8)			;zero nodename
	clrl	64(r8)			;(fill in below if it exists. This
				; prevents stacked junk from being used.
	movl	ddb$l_sb(r1),r1		;get sys block if any
	bgeq	833$			;if none, omit name grab
	movl	sb$t_nodename(r1),60(r8) ;else save nodename
	movl	sb$t_nodename+4(r1),64(r8)
833$:
	movl	ucb$l_ddb(r0),r1	;get DDB (name is there)
	movl	ddb$t_name(r1),68(r8)
	movl	ddb$t_name+04(r1),72(r8)
	movl	ddb$t_name+08(r1),76(r8)
	movl	ddb$t_name+12(r1),80(r8)
; copy device name too. Now msg has all we need to make a unique filename.
; Note we use alloc. class if present, else nodename.
	popr	#^m<r0,r1,r2>

	movl	#1,4(r8)		;flag as an open dmn call
; Now get hold of the filename
; If we have to create the file, this is important. We have or should have
; the DID also.
	pushr	#^m<r0,r1,r2,r3,r4,r5>
; Get the original IRP address for convenience.
	movl	ldt$l_regs+8(R11),R3	;regs start at R2, hold 64 bits
	clrl	96(r8)			;zero size of name initially
	movl	irp$l_qio_p2(r3),r4
	beql	1833$
; test readable addr
	ifnord #8,(r4),1833$
	tstl	(r4)
	BLEQ	1833$
	movl	(r4),96(r8)
	movab	100(r8),r2	;dest addr
	movl	4(r4),r1	;src addr
	beql	1833$
	ifnord #255,(r1),1833$
	bitl	#^xFFFFFF00,(R4)	; if too long junk it
	bneq	1833$
	movzbl	(r4),r3		;length
	beql	1833$		; if none left forget it
	movc3	r3,(r1),(r2)	;copy the filename too!
1833$:
	popr	#^m<r0,r1,r2,r3,r4,r5>
	pushr	#^m<r3,r4,r5>		;ensure ucb etc. get back
	.iif	df,msetrp,movl #32,mtp$trace(r5)
	movl	r9,r5			;ucb of mbx unit
	movl	r8,r4			;where buffer is
	movl	#OpnBfSz,r3			;message size
	jsb	g^exe$wrtmailbox	;emit it
	popr	#^m<r3,r4,r5>
	addl2	#OpnBfSz,sp			;fix stack
	blbs	r0,31$			;if ok, leave for now
30$:
	movl	r11,(sp)		;need clean stack, r11=ldt in r0
	movl	r5,4(sp)		;r1 gets r5
	popr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	bsbw	lclcnt			;helper branch
	rsb
31$:	; Here when mailbox write is done.
; Exit this AST routine and await next.
	popr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	movl	#1,r0		;say ok
	rsb

; Here for "local" operation to continue with the I/O.
; This point will merge AST return and fallthru if anything went
; wrong telling daemon and fallthru where daemon should not be called.
; At entry expect LDT pointer in R11.
; Also we expect jt ucb in r5
lclcnt: .jsb_entry input=<r0,r1>,output=r0
; get stack as we expect it below
	pushr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	movl	r0,r11		; on entry r0 = ldt
	movl	r1,r5
	.iif	df,msetrp,movl #33,mtp$trace(r5)
	jsb	prvidset	;alter privs/idents if appriopriate now
				;(also base prio, etc.)
	.if	df,msetrp
	pushl	r0
	movl	ldt$l_jtucb(r11),r0
	movl	#133,mtp$trace(r0)
	popl	r0
	.endc
	movl	r11,r0		;now restore regs of original I/O
	movab	ldt$l_regs(r0),r1	;regs save r2-r11
	evax_ldq r2,(r1)+
	evax_ldq r3,(r1)+
	evax_ldq r4,(r1)+
	evax_ldq r5,(r1)+
	evax_ldq r6,(r1)+
	evax_ldq r7,(r1)+
	evax_ldq r8,(r1)+
	evax_ldq r9,(r1)+
	evax_ldq r10,(r1)+
	evax_ldq r11,(r1)+
;	movl	(r1)+,r2
;	movl	(r1)+,r3
;	movl	(r1)+,r4
;	movl	(r1)+,r5
;	movl	(r1)+,r6
;	movl	(r1)+,r7
;	movl	(r1)+,r8
;	movl	(r1)+,r9
;	movl	(r1)+,r10
;;	movl	(r1)+,r11	;now have all regs back
; actually, junk r11 again
	movl	r0,r11
; Now re-enable proc. delete, suspend, etc. etc.
; since we're about to reissue user I/O (or dummy junk it)
	movl	ldt$l_prcstr(r11),r10	;get block of info
	bgeq	10$
1$:	tstl	4(r10)		;check del-inhibit count
	bleq	2$		;if 0 or - skip
	decl	4(r10)		;count down del-inhib.
	bgtr	2$		;if gtr, no reenable
	bicl	#<pcb$m_nodelet!pcb$m_nosuspend>,pcb$l_sts(r4)
2$:
10$:
	.if	df,msetrp
	pushl	r0
	movl	ldt$l_jtucb(r11),r0
	movl	#233,mtp$trace(r0)
	popl	r0
	.endc
	movl	#31,-(sp)	;set ef. to end mainline wait
	calls	#1,g^sys$setef	;when we get outta here, that is...
	.if	df,msetrp
	pushl	r0
	movl	ldt$l_jtucb(r11),r0
	movl	#333,mtp$trace(r0)
	popl	r0
	.endc
; See if return status has a couple extra bits to flag we need opnchk
; mode and/or runfcn mode. These are hooks for additional processing if
; needed, should be handy for checking for Trojans...
	bitl	#<^x0e0000>,ldt$l_rtnsts(r11)
	beql	503$
; Be sure this isn't a cond'l softlink return
	cmpw	ldt$l_rtnsts(r11),#7	; is the low order word a softlink
					; return?
	beql	7503$			; if so skip paranoia countup etc
	cmpw	ldt$l_rtnsts(r11),#3	; is the low order word a fake open
					; return?
	beql	7503$			; if so skip paranoia countup etc
	blbc	ldt$l_rtnsts(r11),7503$	; also no countup if failure access
; Looks like one of the magic bits should be set.
; Use the 7th longword in the prcvec structure (64 bytes is 8
; longs now...)
	pushl	r1
	movl	ldt$l_prcstr(r11),r1	;get the proc structure of flags
	bgeq	1503$
	bitl	#^x080000,ldt$l_rtnsts(r11)
	beql	2503$
	incl	<<6-2>*4>(r1)		;bump count of opnchk
	bisl	#ldt$m_opnchk,ldt$l_accmd(r11)
2503$:
        bitl    #^x020000,ldt$l_rtnsts(r11)
        beql    3503$
; set to spawn the test but not recall it since it's for this file only
        bisl    #^x20000000,ldt$l_accmd(r11)
3503$:
	bitl	#^x040000,ldt$l_rtnsts(r11)
	beql	1503$
	incl	<<7-2>*4>(r1)		;bump runfcn count
	bisl	#ldt$m_runfcn,ldt$l_accmd(r11)
; flag bits in ldt and proc struct (since ldt flags get sent to dmn)
1503$:
	popl	r1
7503$:	bicl	#<^x0e0000>,ldt$l_rtnsts(r11)	;clear flag bits if any
503$:
; This should allow the mainline to go on.
; get conditional softlink to return 7,not 1, so we can zap privs back
	cmpl	ldt$l_rtnsts(r11),#7	;cond. softlink path?
	bneq	53$
	movl	#1,ldt$l_rtnsts(r11)	;yes, reset to just status 1
	pushr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
; Do not blow the LDT away at this point. Just reset privs to orig. etc.
	movl	g^ctl$gl_pcb,r4
	.if	df,evax
	movl	ldt$l_bprio(r11),pcb$l_prib(r4)
	.iff
	movb	ldt$l_bprio(r11),pcb$b_prib(r4)
	.endc
	movl	ldt$l_wprv(r11),pcb$q_priv(r4)
	movl	ldt$l_wprv+4(r11),pcb$q_priv+4(r4)
	movl	ldt$l_wprv(r11),g^ctl$gq_procpriv
	movl	ldt$l_wprv+4(r11),g^ctl$gq_procpriv+4
	movl	g^ctl$gl_phd,r4
	movl	ldt$l_aprv(r11),phd$q_authpriv(r4)
	movl	ldt$l_aprv+4(r11),phd$q_authpriv+4(r4)
	movl	ldt$l_wprv(r11),phd$q_privmsk(r4)
	movl	ldt$l_wprv+4(r11),phd$q_privmsk+4(r4)
	.if	df,pcb$ar_natural_psb_def
; Allow mods of PSB based privs etc. if it exists.
; Get data from the PSB if it exists.
	pushl	r9
	pushl	r4
	movl	g^ctl$gl_pcb,r4
	movl	pcb$ar_natural_psb(r4),r9	; point at the PSB block
	movl	ldt$l_aprv(r11),psb$q_authpriv(r9)
	movl	ldt$l_aprv+4(r11),psb$q_authpriv+4(r9)
	movl	ldt$l_wprv(r11),psb$q_permpriv(r9)
	movl	ldt$l_wprv+4(r11),psb$q_permpriv+4(r9)
	popl	r4
	popl	r9
	.endc
	.if	df,msetrp
	pushl	r0
	movl	ldt$l_jtucb(r11),r0
	movl	#433,mtp$trace(r0)
	popl	r0
	.endc
	jsb	undoid		; reset identifiers too
	.if	df,msetrp
	pushl	r0
	movl	ldt$l_jtucb(r11),r0
	movl	#533,mtp$trace(r0)
	popl	r0
	.endc
	popr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
53$:
	movl	r5,ldt$l_chnucb(r11)	;save original chnl ucb
        cmpl    ldt$l_rtnsts(r11),#5    ;just did r/o softl inswap?
        beql    353$
	jsb	setsoftl	;handle softlinks if enabled and needed.
353$:
	.if	df,msetrp
	pushl	r0
	movl	ldt$l_jtucb(r11),r0
	movl	#633,mtp$trace(r0)
	popl	r0
	.endc
	cmpl	r5,ccb$l_ucb(r6)	;new ucb for i/o?
	beql	12$		;if eql no.
	jsb	movldt		;else move LDT to new JT unit links
12$:
	.if	df,msetrp
	pushl	r0
	movl	ldt$l_jtucb(r11),r0
	movl	#733,mtp$trace(r0)
	popl	r0
	.endc
	movl	ccb$l_ucb(r6),r5	;get ccb ucb now
	movl	r5,irp$l_ucb(r3)	;reset IRP device also
;now grab the args and save on stack.
; i.e., DO the user's I/O for him.
; Get args out of LDT
	subl	#24,sp
	movl	sp,r10		;arg area in r10
	movl	ldt$l_parm+00(r11),00(r10)
	movl	ldt$l_parm+04(r11),04(r10)
	movl	ldt$l_parm+08(r11),08(r10)
	movl	ldt$l_parm+12(r11),12(r10)
	movl	ldt$l_parm+16(r11),16(r10)
	.if	ndf,evax
	movl	#0,20(r10)
	.iff
	movl	irp$l_qio_p6(r3),20(r10)
	.endc
; on vax, restore original PSL (for previous mode) here.
	.if	ndf,evax
	movl	ldt$l_psl(r11),-(sp)	;get to original I/O PSL
	bsbb	301$
	brb	302$
301$:	rei
302$:
	.endc
	.if	df,evxrei
	movl	ldt$l_psl(r11),-(sp)	;get to original I/O PSL
	clrl	-(sp)
	pushab	301$			; get 4 byte addr
	movl	#-1,-(sp)		; now have pc,ps on stack as 8 bytes
	evax_stq	r7,-(sp)
	evax_stq	r6,-(sp)
	evax_stq	r5,-(sp)
	evax_stq	r4,-(sp)
	evax_stq	r3,-(sp)
	evax_stq	r2,-(sp)	;ready for PAL call
	evax_imb
	evax_rei
	addl2	#64,sp		;never execute but keep macro-32 happy
301$:
	.endc
	.if	df,evxr64d
	pushl	r0
	pushl	r1
	pushl	ldt$l_psl(r11)	;get original psl
	calls	#1,g^evxr64
	popl	r1
	popl	r0
	.endc
; Now see...should we junk the I/O?
	.if	df,msetrp
	pushl	r0
	movl	ldt$l_jtucb(r11),r0
	movl	#833,mtp$trace(r0)
	popl	r0
	.endc
	cmpl	ldt$l_rtnsts(r11),#3	;secret "fake success"?
	beql	50$
	blbc	ldt$l_rtnsts(r11),60$	;or generate i/o fail?
; no i/o junking...reissue user I.O.
        EXTZV   #IRP$V_FCODE,#IRP$S_FCODE,IRP$L_FUNC(R3),R1     ; GET FCN CODE
	pushr	#^m<r6,r7,r8,r9>
	jsb	getjtucb		;find JT UCB (safely)
	tstl	r0			;got it?
	bgeq	199$			;if not branch (should never happen)
	.iif df,msetrp,movl #933,mtp$trace(r0)
	movl	ucb$l_oldfdt(r0),r7
	bgeq	199$			;if prev fdt illegal, fail
;	movl	ucb$l_ddt(r5),r7	;find FDT
; Here rely on the fact that we got here via our modified FDT call and that
; the orig. FDT is stored just a bit past the current one.
;	movl	<ucb$l_oldfdt-ucb$l_myfdt>(r7),r7	;point at orig. FDT
	addl2	#8,r7			;point at one of 64 fdt addresses
; Get the routine address we need now using the IRP function...
	EXTZV   #IRP$V_FCODE,#IRP$S_FCODE,IRP$L_FUNC(R3),R1     ; GET FCN CODE
	movl	(r7)[r1],r8		;r7 is desired routine address
;now call the "official" FDT code
; Note: the FDT code would normally be called from a $qio with the previous
; mode set accordingly. Here we're inside a skast, no guarantees that the
; previous mode is set right. This means we can't count on access checks being
; right without resetting it by hand. Do so here.
	.if	df,evax
	subl2	#16,sp		; make some stack room
	evax_rd_ps
; psl now in R0
	evax_stq	r0,(sp)		;save our current psl
	evax_stq	r16,8(sp)	;save r16 which we must mess with
	movl	ldt$l_psl(r11),r0	;get original psw
	bicl	#^c3,r0			;leave low 2 bits only
	movl	r0,-(sp)		;save a moment
	movl	4(sp),r0		;get current psl
	bicl	#3,r0			;zero prev. mode
	bisl	(sp)+,r0		;get correct original prev mode
	evax_or	r0,r31,r16		;put into r16 for palcode
	evax_wr_ps_sw
	.endc
	pushl	r6	;ccb
	pushl	r5	;ucb
	pushl	r4	;pcb
	pushl	r3	;irp
	.if	df,msetrp
	pushl	r0
	movl	ldt$l_jtucb(r11),r0
	movl	#1033,mtp$trace(r0)
	movl	r8,mtp$r1(r0)
	popl	r0
	.endc
; reissue user fdt call
	calls	#4,(r8)			;Call the original routine
	.if	df,evax
	evax_ldq	r16,(sp)	;get psl from before fdt code call
	evax_wr_ps_sw			; restore previous mode bits
	evax_ldq	r16,8(sp)	;now get r16 back as before we mucked
	addl2	#16,sp
	.endc
	popr	#^m<r6,r7,r8,r9>
	brb	1199$
;
; Get to 199$ if structures are illegal. Should never happen.
199$:
	popr	#^m<r6,r7,r8,r9>
	movl	#16,r0
	call_finishioc do_ret=no		;lose if illegal structures
	addl2	#24,sp
	popr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	rsb			;exit lclcnt routine
1199$:
;	callg	(r10),fdtlop		;reissue user FDTs
	setipl ipl=#2,environ=UNIPROCESSOR
; axp stores final context in context cell
; Therefore grab that result here, not just R0 which ordinarily from a
; top FDT routine will have a warning status
; To merge with everything else, however, store in R0
	.if	df,evax
	movl	ldt$l_fdtctx(r11),r0
	movl	fdt_context$l_qio_status(r0),r0
	.endc
	brw	70$
50$:
; Daemon disallowed the I/O so undo any driver-done mods to the
; process (privs, ids, base prio) since we will NOT be closing the file.
	movl	#1,r0			;intermediate status must be success
	.if	df,msetrp
	pushl	r0
	movl	ldt$l_jtucb(r11),r0
	movl	#1133,mtp$trace(r0)
	movl	4(sp),mtp$trc2(r0)	;save r0 as of just after user i/o
	popl	r0
	.endc
	pushl	r0			;save i/o status
	jsb	clnprv
	pushl	r0
	pushl	r1
	movl	#1,r0
	call_finishioc do_ret=no
;	callg	(r10),fdtxit		;fake success
	brb	170$
60$:
; Daemon disallowed the I/O so undo any driver-done mods to the
; process (privs, ids, base prio) since we will NOT be closing the file.
; Use "drverr" return instead of "nopriv" to further hide that a security
; monitor is working. Also, RMS should be able to handle this return in any
; case...
; To be consistent here, the intermediate $QIO return needs to return
; success so that ASTs and so forth will be looked for as normal. If
; RMS gets an AST as a result of finishioc but the intermediate return
; was success and caused deallocation of resources, the AST may see
; an inconsistent picture. Therefore fake intermediate SUCCESS return
; but final error.
	movl	#ss$_normal,r0	;fake intermediate success...
	pushl	r0
	jsb	clnprv
	pushl	r0
	pushl	r1
	movl	#ss$_drverr,r0
	call_finishioc do_ret=no
;	callg	(r10),fdtbxt		;failure
170$:
	popl	r1
	popl	r0			;get back r0,r1. r1=new r10 from clnup
	cmpl	r0,r1			;same ucb?
	bneq	270$
	popl	r0
	brb	70$			;if so nothing more needed
270$:	popl	r0			;get i/o status back for intermediate
; clnup found a softlink channel but the daemon disallowed the I/O
; so reset the channel back to the original device here.
	movl	r1,r10
	movl	ccb$l_ucb(r6),r9	;keep old ucb a mo...
	movl	r10,ccb$l_ucb(r6)	;reset user channel to orig. device
; adjust ref counts now
	.if	df,evax
	decl	ucb$l_refc(r9)		;1 less chnl on old dvc
	bgtr	174$			;if 1+, ok
	movl	#1,ucb$l_refc(r9)	;mounted dsk should have 1 or more
174$:	incl	ucb$l_refc(r10)		;bump new count again
	.iff
	decw	ucb$w_refc(r9)		;1 less chnl on old dvc
	bgtr	174$			;if 1+, ok
	movw	#1,ucb$w_refc(r9)	;mounted dsk should have 1 or more
174$:	incw	ucb$w_refc(r10)		;bump new count again
	.endc
; 
70$:
	addl2	#24,sp
	.if	df,msetrp
	pushl	r0
	movl	ldt$l_jtucb(r11),r0
	movl	#1233,mtp$trace(r0)
	movl	4(sp),mtp$trc2(r0)	;save r0 as of just after user i/o
	popl	r0
	.endc
	movl	ldt$l_synch(r11),r10	;get synch block address
; gotta end mainline wait
	bgeq	3$		;skip if illegal
	movl	r0,(r10)	;end the wait now
	bneq	3$
; $qio iosb is 8 off synch blk, but we don't want to fill in till here
; If we have a status (which we should), use it
	tstl	8(r10)		;iosb word 1
	beql	73$
	movl	8(r10),(r10)
73$:
; r0 should basically ALWAYS be nonzero, but just in case...
	movl	#1,(r10)	;set nonzero if it was 0. Usually success here
3$:
	movl	ldt$l_prcstr(r11),r10	;get block of info
	bgeq	20$
	tstl	(r10)		;see if any threads counted
	beql	71$
	decl	(r10)		;count down threads used
71$:	pushl	r0		;save user's fdt r0
	movl	#31,-(sp)	;set ef. to end mainline wait
	calls	#1,g^sys$setef	;when we get outta here, that is...
	popl	r0
20$:
; (The following is belt 'n' suspenders, probably r0 always is odd)
	blbs	r0,25$		;if user i/o failed, reset his
;				; privs, prio for him.
	movl	g^ctl$gl_pcb,r4
	.if	df,evax
	movl	ldt$l_bprio(r11),pcb$l_prib(r4)
	.iff
	movb	ldt$l_bprio(r11),pcb$b_prib(r4)
	.endc
	movl	ldt$l_wprv(r11),pcb$q_priv(r4)
	movl	ldt$l_wprv+4(r11),pcb$q_priv+4(r4)
	movl	ldt$l_wprv(r11),g^ctl$gq_procpriv
	movl	ldt$l_wprv+4(r11),g^ctl$gq_procpriv+4
	movl	g^ctl$gl_phd,r4
	movl	ldt$l_aprv(r11),phd$q_authpriv(r4)
	movl	ldt$l_aprv+4(r11),phd$q_authpriv+4(r4)
	movl	ldt$l_wprv(r11),phd$q_privmsk(r4)
	movl	ldt$l_wprv+4(r11),phd$q_privmsk+4(r4)
	.if	df,pcb$ar_natural_psb_def
; Allow mods of PSB based privs etc. if it exists.
; Get data from the PSB if it exists.
	pushl	r9
	pushl	r4
	movl	g^ctl$gl_pcb,r4
	movl	pcb$ar_natural_psb(r4),r9	; point at the PSB block
	movl	ldt$l_aprv(r11),psb$q_authpriv(r9)
	movl	ldt$l_aprv+4(r11),psb$q_authpriv+4(r9)
	movl	ldt$l_wprv(r11),psb$q_permpriv(r9)
	movl	ldt$l_wprv+4(r11),psb$q_permpriv+4(r9)
	popl	r4
	popl	r9
	.endc
	pushl	r10
	jsb	undoid
	popl	r10
25$:
	.if	df,msetrp
	pushl	r0
	movl	ldt$l_jtucb(r11),r0
	movl	#1333,mtp$trace(r0)
	movl	sp,mtp$trc3(r0)
	popl	r0
	.endc
; exit the AST.
	popr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	movl	#1,r0		;say ok
	rsb

; Local grant/revoke ID code needed because vms internal code won't
; work above IPL0. Ripped off vms listings so's it'll work right,
; kludged by hand to just set things up internally for current
; process only.
; Argument list offsets
;
	v.pidadr = 4		; address of PID
	v.prcnam = 8		; address of process name desc
	v.id	= 12		; address of identifier and attrib
	v.name	= 16		; address of identifier name desc
	v.mode	= 16		; grant/revoke mode for kernel routine
	v.prvatr = 20		; address for previous attributes
;++
;
;	GRANTID - grant identifier to process
;	REVOKID - revoke identifier from process
;
; CALLING SEQUENCE:
;	GRANTID (v.pidadr, v.prcnam, ID, NAME, PRVATR)
;	REVOKID (v.pidadr, v.prcnam, ID, NAME, PRVATR)
;
; INPUT PARAMETERS:
;	v.pidadr: address of PID of process
;	v.prcnam: address of descriptor of process name
;	ID:     address of identifier to grant
;	NAME:   address of descriptor of identifier name
;
; IMPLICIT INPUTS:
;	NONE
;
; OUTPUT PARAMETERS:
;	v.pidadr: address to store resulting PID
;	IDADDR: address to store resulting identifier
;	PRVATR: previous attributes of superseded or revoked identifier
;
;--
	.if	df,evax
grantid: .call_entry preserve=<r2,r3>,home_args=true,max_args=6
	.iff
	.entry grantid,^m<r2,r3>
	.endc
	MOVL	#1,R3			; set grant mode
	BRB	gr10$
	.if	df,evax
revokid: .call_entry preserve=<r2,r3>,home_args=true,max_args=6
	.iff
	.entry revokid,^m<r2,r3>
	.endc
	CLRL	R3			; set revoke mode
gr10$:
	MOVL	v.id(AP),R2		; get pointer to identifier
	BNEQ	20$			; branch if ID specified
	CLRQ	-(SP)			; allocate ID buffer on stack
	MOVL	SP,R2			; and set pointer

20$:	TSTL	(R2)			; see if a binary ID is supplied
	BNEQ	30$			; if so, skip conversion
	brw	40$			; call kernel mode routine with
30$:	PUSHL	v.prvatr(AP)		; previous attributes
	MOVQ	R2,-(SP)		; identifier and mode
	MOVQ	v.pidadr(AP),-(SP)	; v.pidadr & v.prcnam
;	movl	r2,-(sp)
;	movl	r3,-(sp)
;	movl	v.pidadr(ap),-(sp)
;	movl	v.pidadr+4(ap),-(sp)
	calls	#5,grant_revoke		; go do the work. Already in knl mode
40$:	RET

;++
;
;	GRANT_REVOKE - kernel mode rights list handling
;
; FUNCTIONAL DESCRIPTION:
;
;	This routine does the kernel mode processing to grant or
;	revoke an identifier. It locates the specified process
;	and searches and modifies the rights list.
;
; CALLING SEQUENCE:
;	GRANT_REVOKE (v.pidadr, v.prcnam, ID, MODE, PRVATR)
;
; INPUT PARAMETERS:
;	v.pidadr: address of PID of process
;	v.prcnam: address of descriptor of process name
;	ID:     address of identifier to grant
;	MODE:   0 to revoke identifier, 1 to grant
;
; IMPLICIT INPUTS:
;	NONE
;
; OUTPUT PARAMETERS:
;	v.pidadr: address to store resulting PID
;	PRVATR: previous attributes of superseded identifier
;
; IMPLICIT OUTPUTS:
;	NONE
;
; SIDE EFFECTS:
;	Identifier entered in specified rights list
;
; Note: some hackish entries added to TRY to make this work, at least
; in simple cases, where PSBs exist. However these are experimental
; and may fail.
;
;--

; Main subroutine entry point.
; Works on current process, but is OK at elevated IPL (well, ASTDEL...)
;
	.entry grant_revoke,^M<R2,R3,R4,R5,R6,R7,R8,R9>
;GRANT_REVOKE:
;	.WORD	^M<R2,R3,R4,R5,R6,R7,R8,R9>
	CLRQ	R7			; init rights vector index and free pointer
	MOVL	R4,R6			; save PCB addr in R6
	movl	g^ctl$gl_pcb,r4		; current process
	lock lockname=sched,preserve=no ;set synch like exe$nampid does
	movl	pcb$l_pid(r4),r1	; get current process' IPID
	unlock lockname=sched,newipl=#ipl$_ASTDEL
	movl	#ss$_normal,r0		;fake the exe$nampid call
	MOVL	R4,R6			; save PCB address
	.if	df,pcb$ar_natural_psb_def
	movl	pcb$ar_natural_psb(r4),r6	;point at PSB, not PCB
	.endc
50$:
	.if	df,pcb$ar_natural_psb_def
	movl	psb$ar_rights(r6)[r7],r4	;get rightslist seg
	.iff
	MOVL	PCB$Q_PRIV+ARB$L_RIGHTSLIST(R6)[R7],R4 ; get rights list descriptor
	.endc
	BEQL	100$			; branch if none present
	ASHL	#-3,(R4)+,R3		; get rights list length
	MOVL	(R4),R4			; and rights list address

60$:	MOVL	v.id(AP),R1		; get address of identifier
; this is an internal call...KNOW we can access args.
	movl	4(r1),r2
	movl	(r1),r1
;	MOVQ	(R1),R1			; get identifier and attributes
;	MOVL	v.prvatr(AP),R5		; get pointer to prev. atr. longword
	clrl	r5			; no prev attrs
	BRB	90$			; dive into loop
;
; To here when an empty entry is encountered in a list
;
70$:	TSTL	R8			; check if we already have one
	BNEQ	100$			; branch if so
	MOVL	R4,R8			; otherwise save the pointer
	BRB	100$			; chain to next list if any
;
; Search the rights list for the desired identifier
;
80$:	MOVL	(R4),R0			; get next identifier from rights list
	BEQL	70$			; if zero, end of list
	CMPL	R0,R1			; see if matches desired ID
	BEQL	140$			; if yes, exit loop
	ADDL	#8,R4			; next list entry
90$:	SOBGEQ	R3,80$			; loop throught rights list
;
; Identifier not found in this list.
;
100$:	TSTL	R7			; check which list in use
	BNEQ	110$			; branch if not first
	ADDL	#2,R7			; point to extended rights list
	BRB	50$			; and search it

110$:	BLBC	v.mode(AP),120$		; branch if attempted revoke
	TSTL	R8			; see if empty entry found
	BEQL	180$			; branch if not
	movl	r1,(r8)
	movl	r2,4(r8)
;	MOVQ	R1,(R8)			; store identifier in list
120$:	MOVL	#SS$_WASCLR,R0		; if revoke - benign success
130$:	RET
;
; Specified identifier found in rights list
;
140$:	TSTL	R5			; see if prev attributes to be returned
	BEQL	150$			; branch if not
	MOVL	4(R4),(R5)		; store previous attribites
150$:	BLBC	v.mode(AP),160$		; branch to do revoke
	movl	r1,(r4)
	movl	r2,4(r4)
;	MOVQ	R1,(R4)			; store identifier in rights list
	BRB	170$

160$:	ASHL	#3,R3,R3		; compute remaining list size
	ADDL3	#8,R3,R0		; compute size plus one entry
	MOVC5	R3,8(R4),#0,R0,(R4)	; collapse out found list entry
170$:	MOVL	#SS$_WASSET,R0		; set return status
	RET
;
; No empty entries available - extend the rights list
;
180$:	CLRQ	R1			; assume no block present
	.if	df,pcb$ar_natural_psb_def
	movl	psb$ar_rights(r6)[r7],r9	;get rightslist seg
	.iff
	MOVL	PCB$Q_PRIV+ARB$L_RIGHTSLIST(R6)[R7],R9 ; point to rights list again
	.endc
	BEQL	190$			; branch if none exists
	movl	(r9),r1
	movl	4(r9),r2
;	MOVQ	(R9),R1			; get current block size and address
190$:;	MOVQ	R1,R3			; save size and addr for later
	movl	r1,r3
	movl	r2,r4
	ADDL	#ARB$S_LOCALRIGHTS+16,R1 ; increase size and add overhead
	JSB	G^EXE$ALONONPAGED		; and allocate a new one
	BLBC	R0,130$			; branch on failure
	MOVL	R2,R5			; save block address
	SUBL3	#16,R1,(R2)+		; set up actual list length
	MOVAB	8(R2),(R2)+		; and descriptor pointer
	MOVW	R1,(R2)+		; block length
	MOVW	#DYN$C_RIGHTSLIST,(R2)+	; and block type
	movl	r4,-(sp)
	movl	r5,-(sp)
;	MOVQ	R4,-(SP)		; save R4 & R5
	MOVC5	R3,(R4),#0,(R5),(R2)	; copy the contents and zero rest
;	MOVQ	(SP)+,R4		; restore regs
	movl	(sp)+,r5
	movl	(sp)+,r4
	BLBC	R7,200$			; branch if extended process list
	MOVL	(R5),G^EXE$GQ_RIGHTSLIST	; and store in system descriptor
	MOVL	4(R5),G^EXE$GQ_RIGHTSLIST+4	; and store in system descriptor
	MOVL	R4,R0			; get pointer to old block
	BEQL	220$			; branch if none
	SUBL	#12,R0			; point to start of block
	BRB	210$

200$:
	.if	df,pcb$ar_natural_psb_def
	movl	r5,psb$ar_rights(r6)[r7]	;get rightslist seg
	.iff
	MOVL	R5,PCB$Q_PRIV+ARB$L_RIGHTSLIST(R6)[R7] ; set up new pointer
	.endc
	MOVL	R9,R0
	BEQL	220$			; branch if no old block
210$:	JSB	G^EXE$DEANONPAGED		; deallocate the old list
220$:	BRW	50$			; locate free entry and try again

;
; Code to support "exttrnlnm" functions, loaded here to get it into pool.
; Always just use JTA0: to find it. No JTA0: means no work...
; entry: r0=lnmstrlen, r1=addr of lnmstr
; r2=tblstrlen, r3=addr of tblstr, r7=victim pcb
; r6=outbuf address
;$def	ucb$l_ktrln	.blkl	1 ;kast_code adr
;$def	ucb$l_k2tnm	.blkl	1 ;kast_code_2 adr
;
;pid:    .blkl   1	;0
;prcnam: .blkl   1	;4
;pcb:    .blkl   1	;8
;adr:    .blkl   1	;12
;retcod: .blkl   1	;16
;lnmstrlen:		;20
;        .blkl   1
;tblstrlen:		;24
;        .blkl   1
;lnmstr: .blkb   32	;28
;tblstr: .blkb   32	;60
;stat:   .blkl   1	;64
;        .blkl   1	;68
;        .blkb   LNM$C_NAMLENGTH	;72
;	.blkb	1	;make it even
;	.blkl	4	;328
;outbuf: .blkb   LNMX$T_XLATION+LNM$C_NAMLENGTH	;344
;
;
	$lnmstrdef
kast_code: .jsb_entry
	pushl	r11
        pushr   #^m<r1,r2,r3,r4,r5,r6>
; entered in skast.
; require ast param to be an argblk entry
	movl	#64,r0
	.iif	df,x$$$dt,jsb g^ini$brk
	movl	acb$l_astprm(r5),r11	;get arg block
	beql	99$
lnmsl=20	;must match offsets in jttrnlnm
	movl	lnmsl(r11),r0
	movab	28(r11),r1	;lnmstr addr
	movl	24(r11),r2	;tblstrlen
	movab	60(r11),r3	;tblstr
        movl    #PSL$C_USER,r5
	movab	344(r11),r6	;outbuf
        jsb     G^LNM$SEARCH_ONE        ; search for logical
	.iif	df,x$$$dt,jsb g^ini$brk
        popr    #^m<r1,r2,r3,r4,r5,r6>
	movl	r0,16(r11)	;retcod
;
	pushl	r4
	pushl	r2
	movl	8(r11),r4	;get original pcb
        movl    PCB$L_PID(r4),ACB$L_PID(r5)
	movab	kast_code_2,acb$l_kast(r5)
        movb    #<acb$m_nodelete!ACB$M_KAST!PSL$C_KERNEL>,ACB$B_RMOD(r5)
        movl    #0,r2	;no prio bump
	.iif	df,x$$$dt,jsb g^ini$brk
        jsb     G^SCH$QAST              ; requeue AST
	.iif	df,x$$$dt,jsb g^ini$brk
	popl	r2
	popl	r4
	popl	r11
	rsb
99$:	popr	#^m<r1,r2,r3,r4,r5,r6>
	popl	r11
	rsb
;
kast_code_2: .jsb_entry
        pushr   #^m<r1,r4,r5,r11>
	.iif	df,x$$$dt,jsb g^ini$brk
	movl	acb$l_astprm(r5),r11	;get arg block
	beql	100$
	movl	12(r11),r1	;adr
	movl	16(r11),(r1)
        blbc    16(r11),100$
        cvtbl   <340+LNMX$T_XLATION>(r11),4(r1)
        movc3   4(r1),<344+LNMX$T_XLATION>(r11),8(r1) ; save translation
100$:   popr    #^m<r1,r4,r5,r11>
;
        movl    PCB$L_PID(r4),r1
        movl    #0,r2
astefn=17
        movl    #astefn,r3
        jsb     G^SCH$POSTEF            ; set event-flag
        movl    r5,r0
        jsb     G^EXE$DEANONPAGED       ; deallocate ACB and disappear
	rsb
;
JT_END:					;ADDRESS OF LAST LOCATION IN DRIVER
	.END
