.TITLE FDHost - VAX/VMS VIRT DISK Host Process (memory disk) ;xxiosb=1 .IDENT 'V01-002' ;$$xdt=1 ; Note: Initial cut failed. Waiting on event flag 10 is not functioning ; properly. Therefore drop back and create a mailbox and assign a ; channel to it. Driver will notify us of work by sending the buffer ; header to us via exe$wrtmailbox. We have to supply UCB address of ; the mailbox after the size in our initial QIO, in the buffer. ; ; FACILITY: ; ; Host part of a remote virtual disk. This process executes on ; a local machine in conjunction with FDDRV and talks over DECnet ; to a special remote DECnet object. This remote object is installed ; with privilege (log_io) and is able to access a particular disk ; on the remote system, whose name is specified by a logical and whose ; geometry is returned to this program. (The presumtpion is that the ; remote disk and geometry will either be set via command input or via ; logical names, and the geometry must be played back to FDDRV so that ; its' virtual disk will be the same geometry as the actual remote disk. ; This is important for some few VMS components and makes the backup ; and mount work reliably.) ; This process communicates via nontransparent DECnet with the remote ; one to handle actual disk data transfers. Writes may optionally be ; blocked at the remote end if this is to be a read-only access. ; ; This version is intended to achieve "robustness" in the face of network ; outages by closing the network channel here and reopening it. This ; should allow a new remote object to start, using the same disk, ; and allow the I/O to continue as before. This retry operation will be ; done only a limited number of times, but should allow a link to ; survive a brief network outage, particularly if alternate routing ; exists. ; ; Command format: ; FDHost/switches VDn: ; where a .CLD file is expected so that this can all be parsed by ; the CLI. The legal switches will just be /ASSIGN or /DEASSIGN ; to specify which operation is required. In the /DEASSIGN ; case no filename is needed of course; the virtual disk must ; however be dismounted before this utility will allow it to ; be deassigned. The ucb$w_refc field must be zero before the ; deassign is thus permitted. ; Note deassign normally will NOT be via command (I don't see how a ; command could ever be read) but vie exit AST. ; ; Note: define VMS$V5 to build for Version 5.x of VMS. vms$v5=1 ; ; ; AUTHOR: ; ; G. EVERHART ;-- .PAGE .SBTTL EXTERNAL AND LOCAL DEFINITIONS .LIBRARY /SYS$SHARE:LIB/ ; ; EXTERNAL SYMBOLS ; $ADPDEF ;DEFINE ADAPTER CONTROL BLOCK $CRBDEF ;DEFINE CHANNEL REQUEST BLOCK $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 $IRPDEF ;DEFINE I/O REQUEST PACKET $PRDEF ;DEFINE PROCESSOR REGISTERS $PCBDEF ;DEFINE PCB OFFSETS $SCSDEF $SBDEF $STSDEF $STSDEF ; Symbols for returned status. $DVIDEF ; Symbols for $GETDVI service. $DCDEF ; Symbols for device type. $SSDEF ;DEFINE SYSTEM STATUS CODES $UCBDEF ;DEFINE UNIT CONTROL BLOCK $VECDEF ;DEFINE INTERRUPT VECTOR BLOCK ; ; No need for direct UCB access here; this is done via the driver ; itself. We just worry about the files, etc. ; $FIBDEF ; Symbols for file information block. $IODEF ; Symbols for QIO functions. $DVIDEF ; Symbols for $GETDVI calls. $TPADEF ; Symbols for LIB$TPARSE calls. ; Macro to check return status of system calls. ; .MACRO ON_ERR THERE,?HERE BLBS R0,HERE BRW THERE HERE: .ENDM ON_ERR .PSECT FDHostD_DATA,RD,WRT,NOEXE,LONG dvl: .long 0 DESBLK: .LONG 0 .ADDRESS XITHDL ;EXIT HANDLER ADDRESS .long 0 .address dvl .LONG 0,0 ;REST OF EXIT HANDLER CONTROL BLK ; DEFAULT_DEVICE: .ASCID /SYS$DISK/ $ATRDEF $FABDEF $FATDEF $FIBDEF $IODEF $NAMDEF $RMSDEF $XABDEF .ALIGN LONG IOSTATUS: .BLKQ 1 ;** VDV_BUF: ; Buffer to hold VDVice name. .BLKB 40 VDV_BUF_SIZ = . - VDV_BUF VDV_BUF_DESC: ; Descriptor pointing to VDVice name. .LONG VDV_BUF_SIZ .ADDRESS VDV_BUF VPID: ; Owner of VDVice (if any). .BLKL 1 VDV_ITEM_LIST: ; VDVice list for $GETDVI. .WORD VDV_BUF_SIZ ; Make sure we a have a physical device name. .WORD DVI$_DEVNAM .ADDRESS VDV_BUF .ADDRESS VDV_BUF_DESC .WORD 4 ; See if someone has this device allocated. .WORD DVI$_PID .ADDRESS VPID .LONG 0 .WORD 4 .WORD DVI$_DEVCLASS ; Check for a terminal. .ADDRESS VDV_CLASS .LONG 0 .LONG 0 ; End if item list. VDV_CLASS: .LONG 1 ;^^^ mbx_BUF: ; Buffer to hold mbxice name. .BLKB 40 mbx_BUF_SIZ = . - mbx_BUF mbx_BUF_DESC: ; Descriptor pointing to mbxice name. .LONG mbx_BUF_SIZ .ADDRESS mbx_BUF mPID: ; Owner of mbxice (if any). .BLKL 1 mbx_ITEM_LIST: ; mbxice list for $GETDVI. .WORD mbx_BUF_SIZ ; Make sure we a have a physical device name. .WORD DVI$_DEVNAM .ADDRESS mbx_BUF .ADDRESS mbx_BUF_DESC .WORD 4 ; See if someone has this device allocated. .WORD DVI$_PID .ADDRESS mPID .LONG 0 .WORD 4 .WORD DVI$_DEVCLASS ; Check for a terminal. .ADDRESS mbx_CLASS .LONG 0 .LONG 0 ; End if item list. mbx_CLASS: .LONG 1 ;^^^ DEFNAM: WRK: .BLKL 1 ;SCRATCH INTEGER ; DESCRIPTOR FOR VDn: "FILENAME" .ALIGN LONG VDFNM: .WORD 255. ;LENGTH VDFTP: .BYTE DSC$K_DTYPE_T ;TEXT TYPE .BYTE 1 ; STATIC STRING .ADDRESS VDFNMD VDFNMD: .BLKB 256. ; DATA AREA ; VDCHN: .LONG 0 ;CHANNEL HOLDERS ; ; FOR initial use, don't bother allocating the file. Assume the ; user can somehow allocate a contiguous file of the size he wants ; for himself. ; Retcnt: .long 0 ;retry count MBCHN: .long 0 ; channel for mailbox MBUCB: .long 0 ; UCB address for mailbox ASDSC: .ASCID /ASSIGN/ DASDSC: .ASCID /DEASSIGN/ P1DSC: .ASCID /UNIT/ P2DSC: .ASCID /FNAM/ .EVEN ; ; ucb data area HSTUCB: .LONG 0 ;HOST UCB ADDRESS ;Info holders for info from subroutines that access the remote ;machine... NETCHN: .LONG 0 ;CHANNEL TO REMOTE SYSTEM NETTRK: .LONG 0 ;TRACKS RETURNED FROM REMOTE NETSCT: .LONG 0 ;SECTORS FROM REMOTE NETCYL: .LONG 0 ;CYLINDERS FROM REMOTE NETBLKS: .LONG 0 ;SIZE IN BLOCKS FROM REMOTE ; ; Argument lists for external subroutines Openarg: .long 5 ;get channel number, t/s/c/size info .address netchn .address nettrk .address netsct .address netcyl .address NETBLKS ;size of total disk Closarg: .long 1 .address netchn ;for closing net channel ; ;OURPID: .LONG 0 ;PID OF THIS PROCESS iosb: .long 0,0,0,0 ;iosb ioprog: .long 0 ; i/o in progress flag if nonzero ; BUFFER FOR COPIES OF DRIVR DATA BUFHDR: .LONG 0,0,0,0,0 .iif df,fdadr, .long 0 ; if FDDRV is assembled to pass 6 longs fbufsiz=8192. ;buffersize to match maxbcnt for driver fbs4=fbufsiz/4 ; in its' header area BUF: .BLKL fbs4 ; DATA AREA .LONG 0,0 ;SAFETY BUFFERS SETFD: .LONG 0 ;DECLARE PROCESS .LONG 0 ;PID .LONG 1 ;DISK SIZE .LONG 0,0,0,0 ;EXTRA STUFF FOR OTHER CALLS .long 0,0 ;(includes MB UCB, trks, sects, cyls) SETFDL=.-SETFD .LONG 0,0,0,0,0 ;SAFETY ; SBUFHDR: .LONG 0,0,0,0,0,0,0 .PSECT FDHostD_CODE,RD,WRT,EXE,LONG .ENTRY FDHostD,^M ; only fdn: name on command line PUSHAB WRK ;PUSH LONGWORD ADDR FOR RETLENGTH PUSHAB VDFNM ;ADDRESS OF DESCRIPTOR TO RETURN PUSHAB P1DSC ; GET P1 (VDn: UNIT) CALLS #3,G^CLI$GET_VALUE ;GET VALUE OF NAME TO VDFNM ON_ERR FDHostD_EXIT 290$: ; MUST HAVE ASSIGNMENT TO VD: UNIT IN ANY CASE. $ASSIGN_S - DEVNAM=VDFNM,- ; GET CHANNEL FOR VDn: CHAN=VDCHN ON_ERR FDHostD_EXIT ; SKIP OUT IF ERROR $GETDVI_S - CHAN=vdchn,- ; Command line has device name. ITMLST=VDV_ITEM_LIST BLBS R0,140$ BRW FDHostd_EXIT 140$: ; Set up mailbox channel $crembx_s prmflg=#0,chan=mbchn,maxmsg=#576,bufquo=#5760,- promsk=#0 On_ERR fdhostd_exit ; need to get UCB address here somehow... $GETDVI_S - CHAN=mbchn,- ; Command line has device name. ITMLST=mbx_item_list BLBS R0,176$ 190$: BRW FDHostd_EXIT 176$: ; Got now the actual device name of the mailbox ; Next set up the assignment to the remote system ; Initially allow the name to be hard coded or something in the ; subroutine we use to set this up. clrl netchn CALLG G^OPENARG,NETOPN ;OPEN THE NET tstl netchn ;got a channel? beql 190$ ;no. error exit. tstl netblks ;nonzero size (REQUIRED!!!) bneq 191$ ;no, lose now... CALLG g^closarg,NETCLS ;close the net channel brb 190$ ;then scram 191$: ; Let the kernel call perform the UCB lookup for us. ; ; FOUND A UNIT. NOW DECLARE EXIT HANDLER TO CLEAN UP ; IF WE GET A $FORCEX TO TERMINATE THE HOST PROCESS. PUSHAB DESBLK ; ADDRESS OF DESBLK CALLS #1,G^SYS$DCLEXH ; DECLARE EXIT HANDLER ; NOW GET OUR PID FOR USE LATER ; $CMKRNL_S - ROUTIN=BASHUCB,ARGLST=K_ARG ; Now we have the PID for our process in OURPID and are ready to tell ; the driver we're here! MOVL OURPID,SETFD+4 ;STORE PID (IPID!!!) movl netblks,setfd+8 ;size of disk movl mbucb,setfd+12 ; Comm mailbox UCB address CLRL SETFD ; flag that this is the setup movl #setfdl,r4 ; length of buffer movl nettrk,setfd+16 ;tell FDDRV about our geometry movl netsct,setfd+20 movl netcyl,setfd+24 ; Note we must modified func code from io$_format to something with ; a modifier bit set so FDDRV will treat this as OUR special QIO. $qiow_s efn=#1,chan=vdchn, - iosb=iosb,func=#,p1=setfd,p2=R4 ; Communication with the driver MUST remain OK always. ON_ERR FDHostD_EXIT ; SKIP OUT IF ERROR clrl ioprog ; no i/o in progress yet ; now we're ready to await work from the driver clrl retcnt ;zero retry counter first EVTLOOP: ; When FDDRV has work, it sends the buffer header it has via a ; mailbox message. Read that here to get our indication there ; is something to do, and incidentally to get initial info on I/O ; direction and size. ; ; Read the mailbox to get our data ; Use QIOW$ to assure that we don't do anything until there is work. ; (this also avoids having to use internal routines to control ; host execution.) $qiow_s efn=#10,chan=mbchn,- iosb=iosb,func=#io$_readlblk,p1=bufhdr,p2=#20 ON_ERR FDHostD_EXIT ; SKIP OUT IF ERROR ; $qiow_s efn=#1,chan=vdchn,func=#io$_format,p1=#setfd,p2=#setfdl ;SHOULD NOW HAVE HEADER... ; Check call is not spurious. Driver sets 255 in buffer header when it ; gets done an i/o for client, and puts 0 or 1 there for a real ; transfer. cmpl bufhdr,#2 bgtru evtloop ;if not really doing i/o, spurious ef ; set, just ignore MOVL #1,IOPROG ;FLAG AN I/O IN PROGRESS THAT NEEDS TO ;BE COMPLETED CMPL BUFHDR,#1 ;1=WRITE, SOMETHING'S WAITING IN THE DRIVER beql writeop jmp readop ; BNEQ READOP WRITEOP: ; BUFHDR+8 CONTAINS BYTECOUNT FOR DATA PART OF TRANSFER ; MOVL #20,SETFD+8 ;BUFFER HEADER size ; ADDL2 BUFHDR+8,SETFD+8 ;SO ADD HEADER SIZE movl bufhdr+8,setfd+8 MOVL #5,SETFD ;GET DATA only MOVL #BUF,SETFD+4 ;BUFFER HDR ADDRESS movl #1,setfd+12 ;success indicator movl #setfdl,r4 ; Get the DATA from the driver. $qiow_s efn=#1,chan=vdchn, - iosb=iosb,func=#,p1=setfd,p2=R4 ON_ERR FDHostD_EXIT ; SKIP OUT IF ERROR ; LOADS DATA INTO LOCAL BUFFER FROM DRIVER ; NOW HAVE TO MOVE IT INTO STORAGE HERE ; ; Now ship the data OUT over the net to the network channel addl3 #20,bufhdr+8,r4 874$: $qiow_s efn=#2,chan=netchn,- iosb=iosb,func=#,p1=bufhdr,p2=r4 ON_ERR FDHostD_EXIT ; SKIP OUT IF ERROR .iif ndf,retlim,retlim=20 blbs iosb,71$ 875$: incl retcnt ;bump retry counter cmpl retcnt,#retlim ;too big? If so give up on the net link. bgeq 873$ ;give up ; close and reopen the net link. Note the netopen routine gets the size info. jsb netfix tstl netchn beql 875$ brw 874$ 873$: jmp fdhostd_exit 71$: clrl retcnt ; remote host interprets buffer header and will know it must write ; the buffer data to storage at the given block, then finish. ; Since we just have to write, just dump all the data in one fell ; swoop here. ; For good design we need a positive ack that the data really got there. ; therefore look for an IOSB back from the remote. Read it in now via ; the net. $qiow_s efn=#2,chan=netchn,- iosb=iosb,func=#,p1=buf,p2=#8 ON_ERR FDHostD_EXIT ; SKIP OUT IF ERROR ; If the net fails sending the ack, we just let it by since the server ; comes up wanting work. We'll catch it on the next operation. ; However, let the application see that we did not get an ack that ; this particular write was OK. It MIGHT have been OK; we could have ; lost the link after our write. (Indeed, we probably did, since ; we checked the IOSB after the write and it looked OK.) blbs iosb,771$ ; Assume the write went OK. This will normally have been the case ; unless we give up. We lose the ability to catch hardware write ; errors on the remote if the link drops but generally this will be ; the accurate reply. movl #3,bufhdr+12 ;initially set success (alternate!) movw bufhdr+8,bufhdr+14 ;and bytecount what was written 771$: .iif ndf,xxiosb, blbc iosb,cmnj ; check i/o stat blk too blbs buf,cmnj ; Something went wrong at the other end. Signal it to the client via ; write to buffer header in driver. movl buf,bufhdr+12 ;copy IOSB longword 1 movl buf+4,bufhdr+16 ;copy IOSB longword 2 ; To avoid xqp seeing uninterpretable codes, fill in by hand ; here. movw #ss$_drverr,bufhdr+12 ;fill in ss$_drverr always ;Now set up to move this into driver space brb fup cmnj: JMP COMMON fup: movl #20,SETFD+8 ;bash header only incl. IOSB MOVL #BUFhdr,SETFD+4 ;BUFFER HDR ADDRESS MOVL #2,SETFD ;HOST TO DRIVER COPY HDR/DATA movl #setfdl,r4 movl #1,setfd+12 ;success... movl bufhdr+8,setfd+16 ;/length sent $qiow_s efn=#1,chan=vdchn, - iosb=iosb,func=#,p1=setfd,p2=#20 ON_ERR FDHostD_EXIT ; SKIP OUT IF ERROR ; READOP: ; Copy bufhdr (5 longs) to a save area in case we have to retry this all. pushr #^m movab bufhdr,r1 movab sbufhdr,r2 movc3 #20,(r1),(r2) ;copy bufhdr to sbufhdr popr #^m readop2: ; READING DATA TO CLIENT. MUST GET DATA, THEN SEND TO DRIVER. ; Get data from net to send to client ; Now ship the data OUT over the net to the network channel movl #20,r4 ;First write the header to the remote $qiow_s efn=#2,chan=netchn,- iosb=iosb,func=#,p1=bufhdr,p2=r4 ON_ERR FDHostD_EXIT ; SKIP OUT IF ERROR blbs iosb,72$ brw 272$ 72$: addl3 #20,bufhdr+8,r4 ;get total data length ; Now READ the data from the remote including the header. $qiow_s efn=#2,chan=netchn,- iosb=iosb,func=#,p1=bufhdr,p2=r4 ON_ERR FDHostD_EXIT ; SKIP OUT IF ERROR blbs iosb,172$ ; network retry area. On a network error, repeat the whole thing. 272$: incl retcnt ;bump retry counter cmpl retcnt,#retlim ;too big? If so give up on the net link. bgeq 873$ ;give up ; close and reopen the net link. Note the netopen routine gets the size info. jsb netfix tstl netchn ;did we fail to reassign the net channel? beql 272$ ;if so retry again pushr #^m ; reconstitute the buffer header so we really repeat the SAME operation. movab bufhdr,r1 movab sbufhdr,r2 movc3 #20,(r2),(r1) ;copy sbufhdr to bufhdr popr #^m brw readop2 ;error on either part of the operation ;implies redo it all. 873$: jmp fdhostd_exit 172$: clrl retcnt ; Now dump ALL the data, including IOSB, back to the host. ADDL3 #20,BUFHDR+8,SETFD+8 ; GET LENGTH TO XFER MOVL #BUFHDR,SETFD+4 ;BUFFER HDR ADDRESS MOVL #2,SETFD ;HOST TO DRIVER COPY w/header movl #setfdl,r4 movl #1,setfd+12 ;success... movl bufhdr+8,setfd+16 ;/length sent $qiow_s efn=#1,chan=vdchn, - iosb=iosb,func=#,p1=setfd,p2=R4 ON_ERR FDHostD_EXIT ; SKIP OUT IF ERROR ; NOW DATA IS IN DRIVER SPACE AS REQUIRED COMMON: ; NOW TERMINATE THE I/O AND AWAIT MORE WORK. MOVL #1,SETFD ;TERMINATE I/O PACKET MOVL BUFHDR,SETFD+4 ;SAVE TRANSFER DIRECTION MOVL BUFHDR+4,SETFD+8 ; BLOCK # MOVL BUFHDR+8,SETFD+12 ; NO. BYTES IN BUFFER MOVZWL #SS$_NORMAL,SETFD+16 ; IOSB 1 CLRL SETFD+20 ; IOSB 2 ; ALWAYS SUCCESS movl #setfdl,r4 $qiow_s efn=#1,chan=vdchn, - iosb=iosb,func=#,p1=setfd,p2=R4 ON_ERR FDHostD_EXIT ; SKIP OUT IF ERROR ; NOW DONE TRANSFER CLRL IOPROG ; SAY NO I/O IN PROCESS IF WE ARE FORCED TO EXIT JMP EVTLOOP ; BE SURE WE DON'T LEAVE THE CHANNELS ASSIGNED TO THE DEVICES ; EITHER... ; (damfino how this can get here, though... $DASSGN_S CHAN=VDCHN CALLG g^closarg,NETCLS ;close the net channel RET FDHostd_exit: tstl vdchn beql 15$ callg #0,g^xithdl ; Close connection down (if any) 15$: CALLG g^closarg,NETCLS ;close the net channel RET ; ; KERNEL ARG LIST K_ARG: .LONG 2 ;2 ARGS: fd device name, mb device name .ADDRESS VDV_BUF_DESC .address mbx_buf_desc ; BASHUCB - AREA TO MESS UP UCB WITH OUR FILE DATA ; BEWARE BEWARE BEWARE ; runs in KERNEL mode ... HAS to be right. .ENTRY BASHUCB,^M ; TAKEN LOOSELY FROM ZERO.MAR ; Obtains host's PID, and also sets up correct size in driver UCB ; both by cylinder and by block. .if df,$$xdt jsb g^ini$brk ;call xdt .endc .if ndf,vms$v5 MOVL G^SCH$GL_CURPCB,R4 ;;; NEED OUR PCB .iff MOVL G^CTL$GL_PCB,R4 ;;; NEED OUR PCB (VMS V5) ;;; (gets it in internal form, just as needed) .endc ;;; NEED IPID FOR DRIVER'S CALL TO SCH$POSTEF TO THIS HOST!! MOVL PCB$L_PID(R4),OURPID ;;;SAVE OUR PID IN INTERNAL FORM JSB G^SCH$IOLOCKW ;;; LOCK I/O DATABASE CLRL HSTUCB ;;; ZERO "HOST" UCB movl 8(ap),r1 ;;;get mailbox info first jsb g^ioc$searchdev blbc r0,59$ ;;;on failure, give up movl r1,mbucb ;;;store away mailbox UCB MOVL 4(AP),R1 ;;; ADDRESS DVC NAME DESCRIPTORS JSB G^IOC$SEARCHDEV ;;; GET UCB ADDRESS INTO R1 BLBS R0,60$ 59$: BRW BSH_XIT 60$: ; BUGGER THE UCB ; ASSUMES FILE LBN AND SIZE ALREADY RECORDED ; ALSO ASSUMES THAT ZERO LBN OR SIZE MEANS THIS ENTRY NEVER CALLED. ; (REALLY ONLY WORRY ABOUT ZERO SIZE; IF WE OVERMAP A REAL DEVICE ; THEN ZERO INITIAL LBN COULD BE OK.) ; ; Do NOT set device size here; we do that in the initial connect ; code in the driver, which sets up geometry also. movl #fbufsiz,ucb$l_maxbcnt(r1) ;;;reset max byte cnt xfer movl #,ucb$l_devchar(r1) ; MOVL #fd_blocks,UCB$L_MAXBLOCK(R1) ;;; (SAVE SIZE TWICE, FOR RMS ; MOVL #fd_cyl,R0 ;;; GET HOST SIZE IN CYLINDERS ; MOVW R0,UCB$W_CYLINDERS(R1) ;;; SAVE IN UCB FOR REST OF VMS ; This computation is redone in fddrv itself, but do it here also. ; It assumes in fddrv that there are 64 sectors/cylinder. BISW #UCB$M_ONLINE,UCB$W_STS(R1) ;;; FLAG ONLINE NOW BISW #UCB$M_VALID,UCB$W_STS(R1) ;;; AND VOL VALID ;;; THAT'S IT... SHOULD BE OK NOW. MOVL #SS$_NORMAL,R0 BSH_XIT: PUSHL R0 JSB G^SCH$IOUNLOCK ;;; UNLOCK I/O DATABASE (DROP IPL) POPL R0 ;;; REMEMBER R0 RET ;;; BACK TO USER MODE NOW ourpid: .long 0 ;;;store this locally ;;;(avoid paging problems in kernel) ; EXIT HANDLER ; CLEARS I/O ASSIGNMENT TO FD: UNIT ; .ENTRY XITHDL,^M TSTL IOPROG BEQL 1$ MOVL #1,SETFD ;TERMINATE I/O PACKET MOVL BUFHDR,SETFD+4 ;SAVE TRANSFER DIRECTION MOVL BUFHDR+4,SETFD+8 ; BLOCK # MOVL BUFHDR+8,SETFD+12 ; NO. BYTES IN BUFFER MOVZWL #SS$_DRVERR,SETFD+16 ; IOSB 1 ; MOVZWL #SS$_ACCVIO,SETFD+16 ; IOSB 1 CLRL SETFD+20 ; IOSB 2 ; FAILURE movl #setfdl,r4 $qiow_s efn=#1,chan=vdchn, - iosb=iosb,func=#,p1=setfd,p2=R4 1$: CLRL SETFD ;DECLARE/UNDECLARE PUSHAB DESBLK ; ADDRESS OF DESBLK CALLS #1,G^SYS$CANEXH ; CANCEL EXIT HANDLER clrl setfd+4 ;FLAG NOBODY HOME NOW clrl setfd+8 movl #setfdl,r4 $qiow_s efn=#1,chan=vdchn, - iosb=iosb,func=#,p1=setfd,p2=R4 ; declare host no longer is home. CALLG g^closarg,NETCLS ;close the net channel ; Just ignore it if the close arg fails movl #1,r0 ;signal all's well RET ; FINISH EXIT ; netfix routine closes and reopens the net link. If netchn = 0 ; on return, it failed. xsec: .flt4 3.01 netfix: pushl r4 ; First close the net channel so we can reuse it. CALLG g^closarg,NETCLS ;close the net channel clrl netchn pushab xsec ;wait 3 seconds calls #1,g^lib$wait ;to give things a chance to clear ; Now reopen the net channel (and get the size info from the server) ;(we junk the size, since we got it earlier.) CALLG G^OPENARG,NETOPN ;OPEN THE NET tstl netchn ;got a channel? beql 75$ ;no. error exit. tstl netblks ;nonzero size (REQUIRED!!!) bneq 75$ ;no, lose now... CALLG g^closarg,NETCLS ;close the net channel clrl netchn ;flag caller we failed ;then scram 75$: popl r4 ;need r4 intact for our QIO rsb .END FDHostD