try$safe=0 tr$ce=0 step2=1 .TITLE JGDRiver ;skeleton driver implementing ucb linkage .IDENT 'V01h' ; Copyright 1993,1994 Glenn C. Everhart ; All rights reserved ; Author: Glenn C. Everhart ; May be copied or used only with inclusion of the above notice. ; However may be used freely given this, for any purposes public or ; private. Commercial use specifically is permitted. ; ; JGdriver - error reduction intercept driver. ; This driver is designed to be used as a "wedge" in any VMS driver ; of standard type which will act to notice I/O errors and cause retry ; of them for a limited number of times. This should be used where it ; is desired to add extended retry because a base device type might ; in a particular case (e.g. optical disk using dkdriver) tend to have ; more errors than normal and the default error retries may not suffice. ; ; This is an example intercept driver for VMS AXP 6.1 and later (i.e., a ; step 2 driver intercept) which shows how to add FDT time intercepts ; ahead of the normal ones. It defines FDT_ACT entries here ONLY ; for those functions to be serviced in this driver and these should ; return via the PORS label, which will call the original FDT routines ; after servicing things here (unless of course local routines finish ; the I/O off locally in normal step 2 driver ways like calls to the ; finishio or abortio routines). ; ; It is expected that initially an io$_format+128 function will be ; issued with the buffer as described herein to get the driver connected ; with some other device. This calls the mung routine which actually ; intercepts the I/O in such a way that it can be cleared. The intercept ; can be removed with another io$_format+128 call with the buffer set ; to clear the connect. ; ; The IO$_FORMAT call is not assumed to be 64-bit clean but should ; use structures in 32bit space. ; ; Note that within this code one does NOT simply RETurn from the ; local FDT processing. Rather the routines should branch to the PORS ; routine to continue FDT processing using the original FDT context. ; This means that one gets cross routine entries, and it is permissible ; to make PORS a .jsb_entry call and then RET after it. ; ; ; Note too that drivers wanting to use this intercept will operate ; cleanly provided they find start_io by following the chain ; UCB$L_DDT -> DDT$L_STARTIO chain to find the start-io entry point. ; Where a driver startio routine loops back to its start for more ; work, without following the chain, this intercept cannot guarantee ; at which IRP processing will be switched. Should the chain be followed ; in all cases, however, the switch will take effect at once. In either ; case, an IRP gets processed by one path or the other, not both. ; ; The buffer to pass to connect is of form: ;buf: .long 1 ;bash flag ; .long 1000 ;dummy size of disk. Must be > 0 ; .ascid /devicename/ ;device name we should connect to ; ; The disconnect buffer is just like the connect one, except the ; buffer starts with ".long 2" instead of ".long 1" ; ; ; Some sanity checks will refuse to disconnect the intercept unless ; the right device is given and unless an intercept had been done ; in the first place. This is a shade crude, but necessary to prevent ; corruption of the I/O database. It is expected that the intercepts ; here get set up at boot time. ; ; For an example, a little intercept of io$_modify is given which ; can allow extends to be forced to be contiguous-best-try (cbt) ; every Nth time (which tends to keep the extent caches flushed). ; Once this is set up, the FDT entry just calls the normal VMS ; modify FDT functions and lets the I/O go through. It checks that ; it is not messing with a kernel channel, nor with requests for ; contiguous extension, nor with movefile requests, but lets ; other activity go on unchanged. ; ; This is offered since the intercept I published before for intercept ; drivers got badly broken for step2 FDT intercepts. This one on the ; other hand will work. ; ; Note that by testing in the mung routine for FDT address equal to ; the local io$_format intercept fdt, it's possible also to leave ; the target disk's IO$_format FDT entry strictly alone and allow ; that to go thru unaltered. Sending IO$_format+128 to THIS driver ; controls it, but sending to the original driver in that case just ; does what the original driver likes... ; ; Glenn Everhart ; everhart@Arisia.GCE.Com ; ; .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 ; above for Alpha only. ; ; Glenn C. Everhart 1994 ; ;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/ ; There are lots of defs here...more than are really needed, but they ; do no harm & are likely to be useful in intercept code. ; ; Note: ; Probably the easiest way to pull code into nonpaged pool in AXP ; VMS is to build it into some sort of fake driver so the driver ; loader gets it loaded for you. In general an executive module ; loader will work, but having something that looks like a driver ; as here also provides the option of having extra controls in a ; well defined path. Hence this driver is able to (ab)use the ; io$_format opcode (to itself) to connect or disconnect to some ; victim device. A little more fiddling would allow us not to touch ; the io$_format entry for the victim device...that is left as an ; exercise for the reader...but it shows one of the conveniences ; of the technique. If a generic exec module were inserted, there'd ; still be a need to control it. The $qio technique makes it possible ; to pass buffers of commands to the code without having to muck ; with any system services, and without need of defining any new ; ones. The code doesn't have to have anything at all to do with ; what drivers normally do...it can be whatever cruft you usually ; insert in pool for Ghod knows what reason...and can be hooked in ; in ANY way convenient. You just shove it in and let it get loaded ; as you please. ; ; $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 $ipldef $DDTDEF ; DEFINE DISPATCH TBL... .if df,step2 ddt$l_fdt=ddt$ps_fdt_2 ddt$l_start=ddt$ps_start_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 $fdt_contextdef $fdtdef .if df,step2 $fdt_contextdef .endc $sbdef ; system blk offsets $psldef $prdef $acldef $rsndef ;define resource numbers $acedef $VECDEF ;DEFINE INTERRUPT VECTOR BLOCK $pcbdef $statedef $jibdef $acbdef $vcbdef $arbdef $wcbdef $ccbdef $fcbdef $phddef $RABDEF ; RAB structure defs $RMSDEF ; RMS constants ; defs for acl hacking $fibdef $atrdef 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_ctlflgs .blkl 1 ;flags to control modes ; $def ucb$l_cbtctr .blkl 1 ;How many extends done $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 ; The following lets us remember what the original stolen device is ; so we can prevent double bashes... $def ucb$JGcontfil .blkb 80 $def ucb$l_asten .blkl 1 ;ast enable mask store ; ; DDT intercept fields ; following must be contiguous. $def ucb$s_ppdbgn ;add any more prepended stuff after this $def ucb$l_uniqid .blkl 1 ;driver-unique ID, gets filled in ; by DPT address for easy following ; by SDA $def ucb$l_intcddt .blkl 1 ; Our interceptor's DDT address if ; we are intercepted $def ucb$l_prevddt .blkl 1 ; previous DDT address $def ucb$l_icsign .blkl 1 ; unique pattern that identifies ; this as a DDT intercept block ; NOTE: Jon Pinkley suggests that the DDT size should be encoded in part of this ; unique ID so that incompatible future versions will be guarded against. $def ucb$s_ppdend $def ucb$a_vicddt .blkb ddt$k_length ; space for victim's DDT .blkl 4 ;safety $def ucb$l_backlk .blkl 1 ;backlink to victim ucb ; Make the "unique magic number" depend on the DDT length, and on the ; length of the prepended material. If anything new is added, be sure that ; this magic number value changes. magic=^xF013F000 + ddt$k_length + <256*> p.magic=^xF013F000 + ddt$k_length + <256*> $DEF UCB$L_JG_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 ; ; This layout is much easier to deal with than the VAX or STEP1 one... ; fdt$k_length should be 68 longwords for the 64bit case, 66 longs for ; vms 6.1. The code even for 6.1 copied an extra quadword to be certain ; it got everything, so it actually requires no mods for 64 bit FDTs. ; It is essential that the complete FDT and DDT get copied. which ; symbolic use of length symbols will now assure. $def ucb$l_myfdt .blkl <+4>;user FDT tbl copy + slop for safety $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 ; The following lets us steal start-io and add error retries $def ucb$l_omedia .blkl 1 ;storage of orig. irp$l_media $def ucb$l_ppid .blkl 1 ;store for irp$l_pid contents $def ucb$l_retries .blkl 1 ;counter for i/o retries $def ucb$l_hstartio .blkl 1 ;host driver start-io loc. $def ucb$l_hstucb .blkl 1 ;host ucb (quick ref) .if df,tr$ce $def ucb$l_where .blkl 1 ;where we are .endc ; $DEF UCB$K_JG_LEN .BLKW 1 ;LENGTH OF UCB ;UCB$K_JG_LEN=. ;LENGTH OF UCB $DEFEND UCB ;END OF UCB DEFINITONS .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 JG_UNITS=500 JG$DPT:: .iif ndf,spt$m_xpamod,dpt$m_xpamod=0 DPTAB - ;DPT CREATION MACRO END=JG_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_JG_LEN,- ;LENGTH OF UCB MAXUNITS=JG_UNITS,- ;FOR SANITY...CAN CHANGE NAME=JGDRIVER ;DRIVER NAME 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 ; make OUR fork IPL not have bit 5 set, to tell fork dispatcher NOT to get ; a spinlock for OUR fork (so as not to interfere with any locks by having ; the fork dispatch return clear a lock out from under a driver!) DPT_STORE UCB,UCB$B_FLCK,B,SPL$C_IOLOCK8 ;FORK IPL (VMS V5.X + LATER) ; 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. Thus it won't look file oriented ; nor directory structured. The actual characteristics don't matter much, ; just so the device is not picked up by anything as "interesting". DPT_STORE UCB,UCB$L_DEVCHAR,L,- ;DEVICE CHARACTERISTICS ; RANDOM ACCESS DPT_STORE UCB,UCB$L_DEVCHAR2,L,- ;DEVICE CHARACTERISTICS ; 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 ;... ; ; 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,JG_INT ;INTERRUPT SERVICE ROUTINE ADDRESS DPT_STORE DDB,DDB$L_DDT,D,JG$DDT ;DDT ADDRESS DPT_STORE UCB,UCB$L_UNIQID,D,DRIVER$DPT ;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. ; ;JG$DDT: ; Actually the presence of fastio in the intercept driver is of ; no importance either since it isn't really a disk... .if df,irp$q_qio_p1 DDTAB - ;DDT CREATION MACRO DEVNAM=JG,- ;NAME OF DEVICE START=JG_STARTIO,- ;START I/O ROUTINE FUNCTB=JG_FUNCTABLE,- ;FUNCTION DECISION TABLE CTRLINIT=JG_CTRL_INIT,- UNITINIT=JG_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 routine .iff DDTAB - ;DDT CREATION MACRO DEVNAM=JG,- ;NAME OF DEVICE START=JG_STARTIO,- ;START I/O ROUTINE FUNCTB=JG_FUNCTABLE,- ;FUNCTION DECISION TABLE CTRLINIT=JG_CTRL_INIT,- UNITINIT=JG_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 .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: Be sure the FDT table is 8 byte aligned!!!! The addins below are ; 4 longwords which will not screw up quad alignment... .align quad 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 /dflg/ ;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 ; .align quad JG_FUNCTABLE: FDT_INI FDT_BUF - ; BUFFERED functions ; MOUNT VOLUME .if df,irp$q_qio_p1 ; Note that as an intercept driver we copy the target FDT and actually don't ; need this, but do it for beauty. FDT_64 <- ; Functions supporting 64-bit addresses AVAILABLE,- ; Available (rewind/nowait clear valid) NOP,- ; No operation PACKACK,- ; Pack acknowledge READLBLK,- ; Read logical block forward READPBLK,- ; Read physical block forward 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 JG unit and some other device; see ; the JG_format code comments for description of buffer to be passed. fdt_act JG_format,- ;point to host disk ; ; 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!) .if eq,1 fdt_act MFYFilt,- ;modify filter (e.g. extend) .endc myfdtend=. vd_ucbtbl: JG_ucb: JG_utb: .rept JG_units .long 0 .endr .long 0,0,0,0,0,0,0,0,0,0 ; offset address table v_unm=0 ; Note: code elsewhere assumes that the xxvc macro generates 8 bytes. ; If .address generates more than 4, it breaks as coded here!!! .macro xxvc lblct .address vd_fxs'lblct .globl vd_fxs'lblct .long 0 .endm VD_VOADT:: .rept xxvc \v_unm v_unm = .endr driver_code ; ; GETJGUCB - Find JG: 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. ; ; The trick that we have the victim DDT in our intercept UCB and thus can ; find the intercept UCB relatively fast is the best feature here. ; This gives simple lookup of victim driver from intercept code. ; If we can be sure that the intercept situation is static, we can ; avoid a couple PAL calls here that do synch. stuff, but for this ; example, leave 'em in. ; getJGucb: .jsb_entry output= ; clrl r0 ;no UCB initially found pushl r10 pushl r11 ;faster than pushr supposedly ; pushr #^m ; 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 (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. ; .branch_unlikely 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)+,condition=RESTORE,preserve=NO ; NOW clobber r0 and put things back. movl r11,r0 ; popr #^m 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. ; ; If we get here and the DDT points now to someone ELSE'S UCB instead ; of ours, we must keep looking to find OUR UCB. This is done by ; searching the chain we establish so this intercept driver can ; find its own UCB in a finite search. If of course it is the only ; intercept, it gets it right away. 5$: cmpl (r10),#p.magic bneq 3$ ;exit if this is nonstd bash ; follow DDT block chain to next saved DDT. movl (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 ;save regs from movc5 movc5 #0,addr,#0,size,addr popr #^m ;save regs from movc5 .endm ; .SBTTL Our FDT Filter Routines ; These routines are edited from the JGDRiver versions to call ; getJGucb, 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. ; PopOut: popr #^m pors: ; 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. Thus the only FDT routines in THIS driver are the ones ; it needs for its own work, not any standard ones. This calls those. ; Thus, any "continue" returns of our code must wind up calling "pors" ; instead of doing a RET. This will pass the call control along. EXTZV #IRP$V_FCODE,#IRP$S_FCODE,IRP$L_FUNC(R3),R1 ; GET FCN CODE pushr #^m movl r1,r10 jsb getJGucb ;find JG 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 (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...or the next intercept's down anyhow. pushl r6 ;ccb pushl r5 ;ucb pushl r4 ;pcb pushl r3 ;irp calls #4,(r8) ;Call the original routine popr #^m ; Now return as the original routine would. ret 199$: popr #^m movl #16,r0 call_abortio ret ; rsb .if eq,1 ;condition this out 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 +) bleq pors ;if not skip out cmpb ccb$b_amod(r6),#1 ;knl mode access? bleq pors ;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 #^x1FC0,irp$w_func(r3) ;this a movefile or other modifier? .iff bitl #^xDFC0,irp$l_func(r3) ;this a movefile or other modifier? .endc bneq pors ;if so ignore it here. pushr #^m ; original r5 now at 4(sp). Must get that to continue the ops. jsb getJGucb ;find JGDRiver ucb tstl r0 bgeqw popout movl r5,ucb$l_backlk(r0) ;save link'd ucb in ours too. movl r0,r5 ;point R5 at JG UCB ;make sure not a knl mode channel (leave the XQP channel alone!!!) cmpb ccb$b_amod(r6),#1 ;this the XQP's chnl? bleqw popout ; 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.) 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) 701$: popr #^m brw pors mspcj: popl r0 brw popout 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 xx$nor=0 .iif df,xx$nor,ifnord #4,4(r0),mspcj movl 4(r0),r0 ;...from descriptor .iif df,xx$nor,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 i^#32,ucb$l_ctlflgs(r5) ;separate control for setting contig best try beql 1$ ; leave contig and contig-best-try alone bitw #,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. 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$w_exctl(r0) ;else turn on contig best ;try and turn on use of ;system default extension if ;larger than program default 1$: mspc: popl r0 popr #^m movl #1,r0 brw pors .endc ;eq,1 ;++ ; ; JG_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 ;-- JG_format: $driver_fdt_entry bicw3 #io$m_fcode,irp$l_func(r3),r0 ;mask off function code bneq 20$ ;branch if modifiers, special ;thus, normal io$_format will do nothing. brw pors ;regular processing 100$: popr #^m 10$: movzwl #SS$_BADPARAM,r0 ;illegal parameter clrl r1 call_abortio ret ; jmp g^exe$abortio 20$: movl irp$l_qio_p1(r3),r0 ;buff address movl irp$l_qio_p2(r3),r1 ;buff length 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 movl irp$l_qio_p1(r3),r0 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_JG_host_descr+4(r5) subl3 #8,irp$l_qio_p2(r3),- ucb$l_JG_host_descr(r5) bleq 100$ ;bad length movab ucb$l_JG_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 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 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 ; 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) ; This allows us to create fake channels to nla0: and bash them to channels ; to the host devices associated if we need to...stuff like that. movab JG_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 (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),(r10) ;store next-DDT address relative ;to the original victim one 1$: movl #1,ucb$l_mungd(r5) ;say we munged JG 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 #,(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,JG_functable+fdt_prev ;save old FDT ucb address movl ddt$l_fdt(r10),ucb$l_oldfdt(r5) movl ucb$l_uniqid(r5),JG_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 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 ;preserve regs from movc ;actually with 64 bits the FDT length is 64 longs for function addresses, ; 2 longs for buffered, 2 longs for 64 bit mask ; Add a quadword slop to ensure we're long enough. ; movl #<70*4>,r0 ;byte count of a step 2 FDT + slop movl #,r0 ;byte count of a step 2 FDT + slop movc3 r0,(r7),(r9) ;copy his FDT to ours popr #^m ;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 JGDRiver that we service locally. Thus ; all entry cells for the rest will point in the JG FDT to ; exe$illiofunc. movab g^exe$illiofunc,r8 ;get the magic address movab JG_functable,r10 ;r10 becomes JG FDT tbl addl2 #8,r10 ;point at functions addl2 #8,r9 ;his new FDT... movl #64,r11 ;64 functions ; The code below will let the victim driver's IO$_format FDT entry not be ; messed with... .if ndf,b$fmt$ pushl r7 movab JG_format,r7 ; let victim's format fdt by .endc 75$: cmpl (r10),r8 ;this function hadled in JG? beql 76$ ;if eql no, skip movl (r10),(r9) ;if we do it point his fdt at our fcn .if ndf,b$fmt$ cmpl (r10),r7 ;this our io$_format beql 76$ ;if so leave victim's alone .endc ; (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 ; JGDRiver 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 ; 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 ; ; Set up victim's startio toour steal-startio after saving the address here movl ddt$l_start(r8),ucb$l_hstartio(r5) ;save host start-io movl r11,ucb$l_hstucb(r5) ;save backpointer too movab stealstart,ddt$l_start(r8) ;point at our startio ; ; Finally clobber the victim device's DDT pointer to point to our new ; one. movab ucb$a_vicddt(r5),ucb$l_ddt(r11) ; 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)+,- condition=RESTORE,preserve=YES popr #^m 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 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. ; 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 (r10),R11 ;this our own driver? beql 1$ ;if eql yes, end search .if df,chk.err cmpl (r10),#p.magic bneqw 4$ ;exit if this is nonstd bash .endc ;chk.err ; follow DDT block chain to next saved DDT. movl (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 (r10) ;were we intercepted? bgeq 3$ ;if geq no, skip back-fixup ; we were intercepted. Fix up next guy in line. movl (r10),r11 ;point at interceptor movl (r10),(r11) 3$: ; if we intercepted someone, fix up our intercepted victim to skip by ; us also. movl (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 (r10),(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 ; JG_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 JG_functable,r2 ;address of our FDT table clrl r3 movab <0-ucb$a_vicddt>(r10),r4 ;initially point at our ucb ; Also set the JG device offline when we unbash it. This is a simple ; flag that ctl prog. can use to tell if it's been used already. bicl #,ucb$l_sts(r4) 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 (r10),ucb$l_ddt(r5) clrl (r10) ;zero JG munged flag 4$: forkunlock lock=ucb$b_flck(r5),newipl=(sp)+,condition=RESTORE,preserve=YES popr #^m ;copy our prior DDT ptr to next one rsb ; ; Steal-startio. We get here first, and must arrange initial setup here ; so we can check I/O errors and handle them. Do this via stealing the ; irp$l_pid entry. On VAX we had to grab a special bit of pool to do this, ; but on AXP, by this point the irp$q_qio_p1 to _p6 are free to use, so just ; use the last ones there. toorgj: brw toorg awab: brw away ; on entry R3=IRP, r5=host UCB stealstart: $driver_start_entry jsb getjgucb ;find intercept UCB tstl r0 ;did we find it? bgeq awab ;no, scram, but probably hang. movl r5,ucb$l_hstucb(r0) ;else put it in now pushl r5 movl r0,r5 ;point at intercept ucb now ; allow external control over error reduction bitl #1048576,ucb$l_ctlflgs(r5) ;user want error reduction? beql toorgj ;if not skip out ; be sure this is read or write, else just start orig. one ; Thus we don't mess with ANYTHING except read or write. Thus packack etc. ; would also go through basically unaltered. .if ndf,evax EXTZV #IRP$V_FCODE,- ; Extract I/O function code #IRP$S_FCODE,- ; IRP$W_FUNC(R3),R0 .iff EXTZV #IRP$V_FCODE,- ; Extract I/O function code #IRP$S_FCODE,- ; IRP$L_FUNC(R3),R0 .endc ASSUME IRP$S_FCODE LE 7 ; Allow byte mode dispatch ; io$_writecheck is 10 ; io$_writepblk is 11 ; io$_readpblk is 12 ; allow checks on all 3 cmpl r0,#io$_writecheck ;too low? blss toorgj cmpl r0,#io$_readpblk bgtr toorgj ; gotta arrange to get back after done the I/O and to reissue it if ; errors happened and we're not out of count... .iif ndf,maxtries,maxtries=8 ;We'll keep the info in the UCB for debugging, but when the host driver ; that we're intercepting does a request completion, it will unbusy itself ; and dequeue anything else that was in the device queue. As a result, we need ; to track when an IRP has already been modified in this pass, and must ; also just go directly to the original code where that should happen. ; To accomplish this we need storage for: ; 1. Original irp$l_pid ; 2. Original irp$l_media ; 3. Current retry count (and maybe use hi word as a flag that we have this ; IRP) ; ; Since I don't want to mess anything up in the regular IRP, just allocate ; a buffer and use the keydesc slot to point at it. If user has a key, ; we let the i/o by and he takes his chances with device errors. Advertise ; that opticals don't support dec encryption. ; ; start at irp$q_qio_p4 with this so ASSUME that we have 5 longs ; to work with. We start as low in the arg list as possible to not disturb ; anything needed for disks ordinarily for r/w blocks. vv.magic=0 val.magic=^x76543210 vv.retries=4 vv.media=8 vv.pid=12 16$: pushl r2 movab irp$q_qio_p4(r3),r2 ;get location for our stuff vv.magic=0 val.magic=^x76543210 vv.retries=4 vv.media=8 vv.pid=12 vv.bash=16 ; Must save irp$l_media every time thru so split I/O won't get ; messed... ; Also if this is a second time thru, we must ensure that OUR ; postprocessing happens. movl irp$l_media(r3),vv.media(r2) ;save original media address cmpl #val.magic,vv.magic(r2) ;already modified this IRP? bneq 18$ 119$: popl r2 brw toorg ;already modified this irp. No dbl bash 18$: ; pushl r11 ; pushl r10 ; Before we modify the IRP, check AGAIN by seeing if irp$l_pid is ; clobbered to our value. If so, we grabbed it and should not mess ; with it again. ; movzwl ucb$w_unit(r5),r11 ; get our JG unit number ; Each linkage pair is 8 bytes long... ; Thus shift 3 bits to multiply by 8 ; ashl #3,r11,r11 ; Make an offset to the linkage area ; movab vd_voadt,r10 ; get the table base ; addl2 r10,r11 ; r11 now points at the link addr ; cmpl (r11),irp$l_pid(r3) ; Now point irp$l_pid at a proper ; bneq 118$ ; if IRP already bashed skip ; popl r10 ; popl r11 ; brw 119$ ;118$: ; popl r10 ; popl r11 movl #val.magic,vv.magic(r2) ;flag we got it movl i^#maxtries,vv.retries(r2) ;save retry count movl irp$l_media(r3),vv.media(r2) ;save original media address movl irp$l_pid(r3),vv.pid(r2) ;save original pid addr too. popl r2 ; now set up IRP, then call the previous start-io point at ; ucb$l_hstartio(r5) to do the work with registers put back. ; For Alpha, the stack manipulation here is messy to track in machine ; code, so do it in a register. movl r11,-(sp) ; Free up ol' reliable R11 as scratch movl r10,-(sp) ; Free R10 also movzwl ucb$w_unit(r5),r11 ; Need address cell ; following assumes that addresses are 32 bits long so shift by 2 gets us ; to an address offset. ashl #2,r11,r11 ; to get ucb address back at i/o done movab vd_ucbtbl,r10 ; Base of table of UCB addresses addl2 r11,r10 ; Make R10 point to cell for THIS UCB movl r5,(r10) ; Now save our UCB address there ; (THIS ALLOWS US TO GET IT BACK...) ; This trick allows us to leave the rest of the IRP alone. ; Now the tricky bit. ; We must fill the appropriate address into IRP$L_PID for a call at ; I/O completion. We use a table of such routines, one per unit, ; all of the same size so we can calculate the address of the ; routines. However, since the routine addresses can be almost ; anywhere when the compiler gets done with them, we will ; use a table constructed BY the compiler of pointers to them all and ; access via that instead of just forming the address directly. The table ; entries will be left 2 longs in size each. ; Table VD_VOADT is what we need. Note however that the .address operators ; there probably need to change to some more general .linkage directive. movzwl ucb$w_unit(r5),r11 ; get our JG unit number ; Each linkage pair is 8 bytes long... ; Thus shift 3 bits to multiply by 8 ashl #3,r11,r11 ; Make an offset to the linkage area movab vd_voadt,r10 ; get the table base addl2 r10,r11 ; r11 now points at the link addr movl (r11),irp$l_pid(r3) ; Now point irp$l_pid at a proper .if ndf,evax ; must add vjg$dpt address to this IF VAX ; (for AXP the address is ok as is. The difference has to do with the way ; driver loading differs on the 2 machines.) movab jg$dpt,r10 ;start of driver addl2 r10,irp$l_pid(r3) ;now pid should get back ok .endc ; ; Now save our "intercept posting" address for later possible use ; movab irp$q_qio_p4(r3),r0 ;get address of our bash area movl irp$l_pid(r3),vv.bash(r0) ;save pid field we need ; pointer to the desired procedure ; ; GET BACK CONTROL AT VD_FIXSPLIT (VIA JSB) ; ; WHEN HOST'S I/O IS DONE. movl (sp)+,r10 ; Restore R10 movl (sp)+,r11 ; get r11 back & clean stack now ; Now restore registers and go to the original routine. ; This is also where we come to try again. ; Assumes host ucb address on stack, JG ucb address in R5, IRP address in R3 steal2: toorg: movl ucb$l_hstartio(r5),r1 ;address of original routine bgeq awa2 ; if none, things are messed...probably will crash popl r5 ; get back original UCB movl #1,r0 ; set ok status for now ; call original start-io (to ensure high regs are passed correctly) pushl r5 ; ucb arg pushl r3 ; irp arg calls #2,(r1) ; call the original startio brb away awa2: popl r5 away: ; Should get here only after original startio has been called & returned. ret .SBTTL CONTROLLER INITIALIZATION ROUTINE ; ++ ; ; JG_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. ;-- JG_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 ;++ ; ; JG_unit_INIT - UNIT INITIALIZATION ROUTINE ; ; FUNCTIONAL DESCRIPTION: ; ; THIS ROUTINE SETS THE JG: 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. ; ;-- JG_unit_INIT: $driver_unitinit_entry ; Don't set unit online here. Priv'd task that assigns JG unit ; to a file does this to ensure only assigned JGn: get used. ; BISW #UCB$M_ONLINE,UCB$W_STS(R5) ;SET UCB STATUS ONLINE ;limit size of JG: data buffers JG_bufsiz=8192 movl #JG_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!!!) movab DRIVER$DPT,ucb$l_uniqid(r5) movl #^Xb22d4001,ucb$l_media_id(r5) ; set media id as JG ; (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 ; (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 JG: 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 JG_utb,ucb$l_hucbs(r5) ;host ucb table clrl chnflg ;initially set to use our chain of FDTs BICL #UCB$M_ONLINE,UCB$L_STS(R5) ;SET UCB STATUS OFFLINE movl #1,r0 ret ;++ ; ; JG_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. ; ;-- JG_STARTIO: $driver_start_entry ; ; PREPROCESS UCB FIELDS ; ; ASSUME RY_EXTENDED_STATUS_LENGTH EQ 8 ; CLRQ UCB$Q_JG_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 JG_STARTIO ;START REQUEST OVER ;JG_INT:: ;JG_UNSOLNT:: ; POPR #^M ; REI ;DUMMY RETURN FROM ANY INTERRUPT ;; V_UNIT=0 V_UNM=1 .if df,evax VD_FXS0:: .jsb_entry input= .iff VD_FXS0:: .endc MOVL I^#V_UNIT,R4 BSBW VD_FIXSPLIT ;GO HANDLE RSB VD_FXPL==<.-VD_FXS0> ;LENGTH IN BYTES OF THIS LITTLE CODE SEGMENT V_UNIT=V_UNIT+4 ;PASS TO NEXT UNIT .MACRO XVEC LBLC .if df,evax VD_FXS'LBLC: .jsb_entry input= .iff VD_FXS'LBLC: .endc MOVL I^#V_UNIT,R4 BSBW VD_FIXSPLIT RSB .ENDM .REPEAT ; some extra for safety XVEC \V_UNM V_UNIT=V_UNIT+4 ;PASS TO NEXT UNIT V_UNM=V_UNM+1 .ENDR .if df,evax VD_FIXSPLIT: .jsb_entry .iff VD_FIXSPLIT: .endc ; GET OLD PID.. ; IN OUR UCB$PPID LONGWORD... ;some cleanup for host needed here. Note that r5 enters as IRP address. ; Use initial R5 to help reset host's system... PUSHL R4 ;r4 enters with JG unit number movl r5,r3 ;put entering IRP addr in std place MOVAB VD_UCBTBL,R5 ADDL2 (SP)+,R5 ;R5 NOW POINTS AT UCB ADDRESS MOVL (R5),R5 ;NOW HAVE JG UCB ADDRESS IN R5 ; notice stack is now clean too. movl r5,r4 ;we need the jg ucb at fork level ; set lock not releaseable by fastio code here as a precaution ; This may inhibit fastpath code from releasing locks on subsequent ; cycles for split I/O. BBSS #IRP$V_LOCK_RELEASEABLE,IRP$L_STS(R3),20$ 20$: ;Now we either restart the i/o if an error occurred, or go ahead and ; complete it. In either case we must fork. Also we must fork on ; the JG UCB since the host driver has no idea we might use its ; fork and can conflict. We will get the host UCB in the fork ; itself. ; Therefore get host ucb again and fork on that. .iif df,tr$ce,movl #1,ucb$l_where(r5) ;;; movl ucb$l_hstucb(r5),r5 ;note jg ucb still in r4 .if df,frk$do .if df,try$safe dsbint ipl=#ipl$_synch,environ=uniprocessor FORK routine=87$,continue=77$ ;go fork on our UCB now (vd: ucb) 77$: enbint rsb 87$: fork_routine,environment=jsb .iff fork environment=jsb .endc .iff devicelock savipl=-(sp),preserve=yes .endc movl ucb$l_hstucb(r5),r5 ;note jg ucb still in r4 .iif df,tr$ce,movl #2,ucb$l_where(r4) ; Now see if we need to reissue the I/O. If so, go do it. ; r4 should still be jg ucb, r5=host ucb, r3=irp movq irp$l_media(r3),r0 ;get i/o status blbs r0,40$ ;if status is OK, just finish up here. movab irp$q_qio_p4(r3),r0 ;get our buffer area bgeq 40$ decl vv.retries(r0) ;count retries down bleq 40$ ;if so also finish now ;looks like we need to continue. Therefore go do so. ; Note that at this point the stack is clean and r3 and r5 are irp and ucb ; of host as his start-io will expect. ; (This will nead some tweaks for axp procedure nesting. OK on Vax though.) ; r5 points at host UCB now. ; Now reset the media field so the IRP will work next time .iif df,tr$ce,movl #3,ucb$l_where(r4) movl vv.media(r0),irp$l_media(r3) ; If the host driver clobbered this field, we must ensure we get back ; here as soon as we hit the next start-io for this driver. Actually it should ; be fixed like so now or we wouldn't be here...but be safe anyway. movl vv.bash(r0),irp$l_pid(r3) ;arrange us to get back ; can't just call the original code since the driver may be busy with ; something else. Our fork synch doesn't completely prevent this, since ; the relevant test is whether the driver is busy. Therefore call exe$insioqc ; to do it instead, relying on our tests in stealstart to detect ; that this IRP has already been set up. ; Note that we have left the irp$l_pid address still unchanged so that it ; still will get back here next time around, so again we can check it. ; For this we insert in the original device queue so leave ; r5 pointing at it. Note that steal2 entry wants original R5 on ; the stack but no longer requires R5 pointing at JG UCB. pushr #^m ; movzbl ucb$b_flck(r5),r2 ;get lock ; .iif df,tr$ce,movl #4,ucb$l_where(r4) ; verify_lock_ownership lockindex=r2 ;do we still have iolock8? ; blbs r0,2240$ ;if we have lock, proceed ; .iif df,tr$ce,movl #5,ucb$l_where(r4) ; forklock preserve=YES ;get lock back for fork routine exit ;2240$: .iif df,tr$ce,movl #6,ucb$l_where(r4) .iif df,x$$$dt,jsb g^ini$brk call_insioqc ;get host to work again .iif df,tr$ce,movl #7,ucb$l_where(r4) .iif df,x$$$dt,jsb g^ini$brk ; movzbl ucb$b_flck(r5),r2 ;get lock ; verify_lock_ownership lockindex=r2 ;do we still have iolock8? ; blbs r0,240$ ;if we have lock, proceed ; .iif df,tr$ce,movl #8,ucb$l_where(r4) ; forklock preserve=YES ;get lock back for fork routine exit ;240$: popr #^m movl #1,r0 ;flag all seems well .iif df,tr$ce,movl #9,ucb$l_where(r4) .if ndf,frk$do movl r4,r5 ;we use pseudo dvc devicelock,not target's deviceunlock newipl=(sp)+,preserve=yes movl ucb$l_hstucb(r5),r5 ;note jg ucb still in r4 .endc rsb ;return when done. ; 40$: ; Reset the IRP to have the original return ; Thus the IRP will really complete next, not come back here. 1501$: ;; GRAB R0 AND R1 AS REQCOM IN HOST DRIVER LEFT THEM... ; MOVL IRP$L_MEDIA(R3),R0 ;GET BACK R0 ; MOVL IRP$L_MEDIA+4(R3),R1 ;AND R1 ; R0, R1 ARE AS HOST DRIVER LEFT THEM. R5 POINTS TO CORRECT UCB. .iif df,tr$ce,movl #10,ucb$l_where(r4) ; ; Now restore the original IRP$L_MEDIA field of the IRP in case error ; paths in IOC$REQCOM ever need it. Some very low XQP cache situations ; may occasionally need this, though in reasonable sysgen configs it ; should never be needed. This is the one area that got bashed during ; the earlier I/O completion processing in the host driver. ; ; This will then appear to be coming from the original driver. pushl r4 ; Restore media and pid fields and deallocate the extra field. movab irp$q_qio_p4(r3),r4 ;get our buffer ; for com$post use must leave status in IRP so we do NOT restore irp$l_media ; at this time. ; ; Do however restore irp$l_pid to its original value and ensure the IRP ; is marked as "not bashed" in case there is a next time through. movl vv.pid(r4),irp$l_pid(r3) ;restore pid so post is normal ; By clearing the "bashed" area every time, when we get a successful I/O we ; arrange that the error count restarts as it should if thei/o is split. clrl vv.magic(r4) ;set to re-bash next time popl r4 ;(this may be the problem area; what unbusies the host driver & when? ; Host driver called reqcom to get here which cleared his unit busy. ; If his unit is not busy now, this isn't really a problem. If it IS busy ; however, this IS a problem, as we really have no business touching ; the host's UCB busy bit from here. Let's try using com$post instead ; to finish things up.) forklock ucb$b_flck(r5),- savipl=-(sp),preserve=YES pushl r4 pushl r5 pushl r5 ; ucb pushl r3 ; irp .iif df,tr$ce,movl #11,ucb$l_where(r4) calls #2,g^com_std$post ;com$post replacement ;;; jsb g^com$post ; complete the request but leave busy ALONE popl r5 popl r4 forkunlock lock=ucb$b_flck(r5),newipl=(sp)+,- condition=RESTORE,preserve=YES .iif df,tr$ce,movl #12,ucb$l_where(r4) ; pushl r2 ; movzbl ucb$b_flck(r5),r2 ;get lock ; verify_lock_ownership lockindex=r2 ;do we still have iolock8? ; blbs r0,1601$ ;if we do, branch ;; someone (driver maybe?) freed iolock8. get back so fork exit can release ; .iif df,tr$ce,movl #12,ucb$l_where(r4) ; forklock preserve=YES ;1601$: popl r2 .iif df,tr$ce,movl #13,ucb$l_where(r4) movl #ss$_normal,r0 .if ndf,frk$do movl r4,r5 ;we use pseudo dvc devicelock,not target's deviceunlock newipl=(sp)+,preserve=yes movl ucb$l_hstucb(r5),r5 ;note jg ucb still in r4 .endc RSB ; GET BACK TO HOST SOMETIME JG_END: ;ADDRESS OF LAST LOCATION IN DRIVER .END