	.TITLE	JTDRiver	;skeleton driver implementing ucb linkage
; Copyright (c) 1994 Glenn C. Everhart. All Rights Reserved.
	.if	eq,1	;condition out the following
The enclosed files, jtdriveraxp.mar and jtdmnaxp.mar, are technology developed
by me, Glenn C. Everhart, prior to coming to Digital Equipment Corp.
and are my property.

However, I am willing to grant to Digital a perpetual, nonexclusive,
royalty free license to use and modify these pieces of code for purposes
of merging multiple filesystems under one directory structure and/or
for using a database manager or similar process in lieu of top level
directory processing for presenting one or more file structures in a
virtual hierarchy. (I have sent suggestions along these lines to various
people in the VMS filesystems group.)

These pieces of code represent the critical kernel technology for intercepting
I/O at FDT time. The open interception in particular shows how to insert
a thread of kernel execution into (and ahead of) normal processing, for
higher throughput in handling the interception.

While I grant access to the code for the purposes mentioned, I explicitly
do NOT grant free use of the code for purposes of duplicating the functions
of my Safety product. Should Digital wish to duplicate these and incorporate
them in OpenVMS, it must have another agreement with me, which I would
expect to include compensation. Should such be negotiated I am willing to
release the remainder of the code which implements Safety functions.

(Safety provides space monitoring, hierarchical storage, security
enhancements and monitoring, integrity controls, privilege controls,
and support of undelete. The fragmentation avoidance code included here
and in Safety may however be freely used by Digital with no further
notice.)

While the jtdriver code here is complete as it stands (and is linked like
a normal Alpha VMS driver), the jtdmn code expects a number of
additional functions to be supplied. These are not all supplied here,
but their inputs may be deduced from the code.

I can provide some additional bits of information at need.

My hope in doing this is to facilitate VMS Engineering's ability to
produce a file system suitable for a Galaxy class system without the
time needed to build an entirely new file system. The kernel functions
are pretty well all here for many of the desired functions. The rest
could be done in user mode servers, although file creation might be
faster if handled in a kernel thread along the same lines as that present
herein for open processing.

The copyright notice and evidence of authorship are not to be removed
although others may be added for derivative works, covering new
material.

Glenn C. Everhart
27 May, 1997

% ====== Internet headers and postmarks ======
% Received: from mail13.digital.com by us2rmc.zko.dec.com (5.65/rmc-22feb94) id AA28030; Tue, 27 May 97 20:09:16 -0400
% From: everhart@arisia.gce.com
% Received: from arisia by mail13.digital.com (8.7.5/UNX 1.5/1.0/WV) id UAA07657; Tue, 27 May 1997 20:01:29 -0400 (EDT)
% Date: Tue, 27 May 1997 19:48:52 -0400
% Message-Id: <97052719485185@arisia.gce.com>
% To: star::everhart
% Subject: JTdriver stuff
% X-Vms-To: GCE
% X-Vms-Cc: EVERHART
	.endc	; if eq,1


;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
	.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.
	.if	df,swcompat
$def	ucb$a_more	.blkl	10	;flags (2 longs) etc (8 longs)
	.endc
$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.
	.if	df,swcompat
magic=^xF0070000 + ddt$k_length + <256*<ucb$s_ppdend-ucb$s_ppdbgn>>
p.magic=^xF0070000 + ddt$k_length + <256*<ucb$s_ppdend-ucb$s_ppdbgn>>
	.iff
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>>
	.endc
	.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
; We want to be sure there tend to be a few free blocks left. This is
; quite arbitrary. If there are less than that many blocks before the
; extend, or will be after the extend, go hunt for space.
freslop=20
	cmpl	r10,#freslop		;do we have at least freslop left?
	blssu	1850$			; if not better make some room
	subl2	#freslop,r10		;else subtract slop off
	cmpl	fib$l_exsz(r0),r10		;enough room there?
	blssu	850$			;if lss then all OK
1850$:	movl	ucb$l_maxblock(r9),r9	;disk size
	ashl	#-3,r9,r9		;divide by 8
	cmpl	fib$l_exsz(r0),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
