.TITLE JQDRiver ;skeleton driver implementing ucb linkage .IDENT 'V01b' ; public domain, usage encouraged. ; Author: Glenn C. Everhart ; ;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... $ptedef $vadef $IRPDEF ;DEFINE I/O REQUEST PACKET $irpedef $PRDEF ;DEFINE PROCESSOR REGISTERS $SSDEF ;DEFINE SYSTEM STATUS CODES $UCBDEF ;DEFINE UNIT CONTROL BLOCK $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_oldfdt .blkl 1 ;fdt tbl of prior fdt chain ; ; ; ; Add other fields here if desired. ; ; ; ; ; ; ; here is one example additional field $def ucb$l_ctlflgs .blkl 1 ;flags to control modes ; $def ucb$l_JQ_host_descr .blkl 2 ; char string descr ; ; $def ucb$l_prcvec .blkl 1 ;process local data tbl $def ucb$l_daemon .blkl 1 ;daemon pid $def ucb$l_mbxucb .blkl 1 ;mailbox for input to daemon $def ucb$l_jnldae .blkl 1 ;pid of write jnl daemon $def ucb$l_jnlucb .blkl 1 ;mailbox ucb for journal $def ucb$l_ctlflgs .blkl 1 ;flags to control modes $def ucb$l_dirdae .blkl 1 ;directory daemon pid $def ucb$l_ddmbx .blkl 1 ;mailbox ucb for dir daemon $def ucb$l_rvdae .blkl 1 ;pid of rvb daemon $def ucb$l_rvmbx .blkl 1 ;ucb of mbx to rv daemon $def ucb$l_keycry .blkl 2 ;ucb resident "key" for ACEs $def ucb$l_jnltbl .blkl 1 ;loc of jnltbl, for reference $def ucb$l_jnltbw .blkl 1 ;working loc of jnl tbl $def ucb$l_jnltbe .blkl 1 ;end of jnl tbl $def ucb$l_jnllok .blkl 1 ;journal lock flag $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$l_exmbx .blkl 1 ;extend daemon mailbox $def ucb$l_exdae .blkl 1 ;extend daemon pid $def ucb$JQcontfil .blkb 80 $def ucb$l_asten .blkl 1 ;ast enable mask store $def ucb$l_mstrp .blkl 1 ;mousetrap record place ; $DEF UCB$L_JNLCNT .BLKL 1 ;JOURNAL MSG COUNTER (wvb) ; 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=^xF012F000 + ddt$k_length + <256*> p.magic=^xF012F000 + ddt$k_length + <256*> $DEF UCB$K_JQ_LEN .BLKW 1 ;LENGTH OF UCB ;UCB$K_JQ_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 ; .PSECT $$$105_PROLOGUE JQ_UNITS=3 JQ$DPT:: .if ndf,vms$$v6 DPTAB - ;DPT CREATION MACRO END=JQ_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_JQ_LEN,- ;LENGTH OF UCB MAXUNITS=JQ_UNITS,- ;FOR SANITY...CAN CHANGE NAME=JQDRIVER ;DRIVER NAME .iff DPTAB - ;DPT CREATION MACRO END=JQ_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_JQ_LEN,- ;LENGTH OF UCB MAXUNITS=JQ_UNITS,- ;FOR SANITY...CAN CHANGE NAME=JQDRIVER ;DRIVER NAME .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 ; 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$_DISK ;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,21 ;DEVICE IPL DPT_STORE UCB,UCB$B_ERTMAX,B,10 ;MAX ERROR RETRY COUNT DPT_STORE UCB,UCB$W_DEVSTS,W,- ;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,VR_INT ;INTERRUPT SERVICE ROUTINE ADDRESS DPT_STORE CRB,CRB$L_INTD+VEC$L_INITIAL,- ;CONTROLLER INIT ADDRESS D,JQ_ctrl_INIT ;... DPT_STORE CRB,CRB$L_INTD+VEC$L_UNITINIT,- ;UNIT INIT ADDRESS D,JQ_unit_INIT ;... DPT_STORE DDB,DDB$L_DDT,D,JQ$DDT ;DDT 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. ; ;VR$DDT: DDTAB - ;DDT CREATION MACRO DEVNAM=JQ,- ;NAME OF DEVICE START=JQ_STARTIO,- ;START I/O ROUTINE FUNCTB=JQ_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 ; ; FUNCTION DECISION TABLE ; ; THE FDT LISTS VALID FUNCTION CODES, SPECIFIES WHICH ; CODES ARE BUFFERED, AND DESIGNATES SUBROUTINES TO ; PERFORM PREPROCESSING FOR PARTICULAR FUNCTIONS. ; ; 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 JQ_FUNCTABLE: newfdt: FUNCTAB ,- ;LIST LEGAL FUNCTIONS ; MOUNT VOLUME ; no-op phys I/O for a test here... FUNCTAB ,- ;BUFFERED FUNCTIONS ; MOUNT VOLUME FUNCTAB JQ_ALIGN,- ;TEST ALIGNMENT FUNCTIONS ; io$_format + modifiers (e.g. io$_format+128) as function code ; allows one to associate a JQ unit and some other device; see ; the JQ_format code comments for description of buffer to be passed. functab JQ_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. Functab fdtswitch,- 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 VOLUME FuncTab MFYFilt,- ;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. FuncTab fdttoorig,- ; 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 FUNCTAB +ACP$WRITEBLK,- ;WRITE FUNCTIONS FUNCTAB +ACP$ACCESS,- ;ACCESS FUNCTIONS FUNCTAB +ACP$DEACCESS,- ;DEACCESS FUNCTION FUNCTAB +ACP$MODIFY,- ;MODIFY FUNCTIONS FUNCTAB +ACP$MOUNT,- ;MOUNT FUNCTION ; MOUNT VOLUME FUNCTAB +EXE$ZEROPARM,- ;ZERO PARAMETER FUNCTIONS ; AVAILABLE FUNCTAB +EXE$ONEPARM,- ;ONE PARAMETER FUNCTION FUNCTAB +EXE$SENSEMODE,- ;SENSE FUNCTIONS FUNCTAB +EXE$SETCHAR,- ;SET FUNCTIONS .PSECT $$$115_DRIVER ; 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: tstl fdtonoff ;global on/off bneq 1$ rsb ;go to next FDT if null 1$: addl2 #,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: ; As a performance feature, use a switch to let us just use the ; FDT chain here rather than continuing an old one. This needs to ; be settable externally since there is no need to return down a ; chain unless something else is IN the chain. ; Control this with chnflg tstl chnflg beql 2$ ;just continue if chnflg is 0 pushl r0 ; (this routine gets called a fair bit and if GETJQUCB can be ; called less, things speed up.) jsb getJQucb ;get UCB for JQ 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. ; ; GETJQUCB - Find JQ: 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. getJQucb: ; 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 JQ$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. ; 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 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 (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 JQdriver versions to call ; getJQucb, 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 rsb mfyfilt: ;filter on MODIFY requests (e.g. extend) pushr #^m ; original r5 now at 4(sp). Must get that to continue the ops. jsb getjqucb ;find jqdriver ucb tstl r0 bgeqw popout movl r5,ucb$l_backlk(r0) ;save link'd ucb in ours too. movl r0,r5 ;point R5 at JQ UCB bitl i^#2,ucb$l_ctlflgs(r5) ;look at mfy? bneq m11$ ;if neq yes ; (test later will see about space control if doing this) bitl i^#512,ucb$l_ctlflgs(r5) ;doing space control? beql 701$ pushl r0 movl p1(ap),r0 ;get fib beql 702$ ifnord #4,4(r0),m2$ movl 4(r0),r0 ;...from descriptor beql 702$ brw m2$ ;if so go handle space control 701$: popr #^m rsb 702$: POPL R0 popr #^m RSB m11$: ; 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 movl p1(ap),r0 ;get fib ifnord #4,4(r0),m2$ movl 4(r0),r0 ;...from descriptor ifnord #4,fib$w_exctl(r0),m2$ bitw #fib$m_extend,fib$w_exctl(r0) ;extending at all? beqlw m2$ ;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. bitl i^#16384,ucb$l_ctlflgs(r5) ;allow aldef? beql 704$ bisw #,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$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 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 32768 bit is clear, allow size ctl always. Otherwise only if aldef set. bitl i^#32768,ucb$l_ctlflgs(r5) beql 2222$ bitw #,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 m2$: popr #^m RSB mfymount: ; stick processing in here if doing anything at io$_mount i/o time. ; for here, do nothing. rsb ;++ ; ; JQ_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 ;-- JQ_format: bicw3 #io$m_fcode,irp$w_func(r3),r0 ;mask off function code bneq 20$ ;branch if modifiers, special ;thus, normal io$_format will do nothing. rsb ;regular processing 100$: popr #^m 10$: movzwl #SS$_BADPARAM,r0 ;illegal parameter clrl r1 jmp g^exe$abortio 20$: movl p1(ap),r0 ;buffer address movl p2(ap),r1 ;length of buffer 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 p1(ap),r0 ;get buffer address 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_JQ_host_descr+4(r5) subl3 #8,p2(ap),- ;set length of name in descriptor ucb$l_JQ_host_descr(r5) bleq 100$ ;bad length movab ucb$l_JQ_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 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$: 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 jmp g^exe$finishioc ;wrap things up. mung: ; 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. 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 ; 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 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,JQ_functable+fdt_prev ;save old FDT ucb address movl ddt$l_fdt(r10),ucb$l_oldfdt(r5) movl ucb$l_uniqid(r5),JQ_functable+fdt_idnt ;save unique ID also movab JQ_functable,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. 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)+,- preserve=YES popr #^m rsb umung: ; ; 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 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 (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 ; JQ_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 JQ_functable,r2 ;address of our FDT table clrl r3 movab <0-ucb$a_vicddt>(r10),r4 ;initially point at our ucb 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) 4$: forkunlock lock=ucb$b_flck(r5),newipl=(sp)+,preserve=YES popr #^m ;copy our prior DDT ptr to next one rsb .SBTTL CONTROLLER INITIALIZATION ROUTINE ; ++ ; ; JQ_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. ;-- JQ_ctrl_INIT: ;JQ CONTROLLER INITIALIZATION CLRL CRB$L_AUXSTRUC(R8) ; SAY NO AUX MEM RSB ;RETURN .SBTTL INTERNAL CONTROLLER RE-INITIALIZATION ; ; INPUTS: ; R4 => controller CSR (dummy) ; R5 => UCB ; ctrl_REINIT: RSB ; RETURN TO CALLER .SBTTL UNIT INITIALIZATION ROUTINE ;++ ; ; JQ_unit_INIT - UNIT INITIALIZATION ROUTINE ; ; FUNCTIONAL DESCRIPTION: ; ; THIS ROUTINE SETS THE JQ: 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. ; ;-- JQ_unit_INIT: ;JQ UNIT INITIALIZATION ; Don't set unit online here. Priv'd task that assigns JQ unit ; to a file does this to ensure only assigned JQn: get used. ; BISW #UCB$M_ONLINE,UCB$W_STS(R5) ;SET UCB STATUS ONLINE ;limit size of JQ: data buffers JQ_bufsiz=8192 movl #JQ_bufsiz,ucb$l_maxbcnt(r5) ;limit transfers to 8k MOVB #DC$_DISK,UCB$B_DEVCLASS(R5) ;SET DISK DEVICE CLASS ; 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 #^Xb22b4001,ucb$l_media_id(r5) ; set media id as JQ ; (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 JQ: 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 .if df,j$$vdsk ;normally not defined movl r5,ucb$l_backlk(r5) ;backlink UCB initially our own ; Set up to point the JQ unit DDT at its own UCB initially. pushr #^m ;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 ;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 RSB ;RETURN .SBTTL Other FDT ROUTINES ;++ ; ; JQ_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 JQ_ALIGN: ;CHECK BYTE COUNT AT P1(AP) BLBS 4(AP),10$ ;IF LBS - ODD BYTE COUNT RSB ;EVEN - RETURN TO CALLER 10$: MOVZWL #SS$_IVBUFLEN,R0 ;SET BUFFER ALIGNMENT STATUS JMP G^EXE$ABORTIO ;ABORT I/O .SBTTL START I/O ROUTINE ;++ ; ; JQ_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. ; ;-- JQ_STARTIO: ;START I/O OPERATION ; ; PREPROCESS UCB FIELDS ; ; ASSUME RY_EXTENDED_STATUS_LENGTH EQ 8 ; CLRQ UCB$Q_JQ_EXTENDED_STATUS(R5) ; Zero READ ERROR REGISTER area. ; ; BRANCH TO FUNCTION EXECUTION bbs #ucb$v_online,- ; if online set software valid ucb$w_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 ; 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 JQ_STARTIO ;START REQUEST OVER JQ_INT:: JQ_UNSOLNT:: POPR #^M REI ;DUMMY RETURN FROM ANY INTERRUPT ;; JQ_END: ;ADDRESS OF LAST LOCATION IN DRIVER .END