.TITLE FDHostfile - VAX/VMS VIRT DISK Host Process (file disk) .IDENT 'V01-001' ; ; FACILITY: ; ; Host process for FD: unit that uses a disk file as a file virtual ; disk. The disk file must be specified. ; The file need not be contiguous. ; ; Command format: ; FDHost/switches VDn: filespec ; where a .CLD file is expected so that this can all be parsed by ; the CLI. ; This is a somewhat stripped down version of the FDHOST that goes to ; a file and encrypts it. No encryption is present, but the file exists ; and is treated as a disk. File is accessed as 512 byte records. Unlike ; VD: type virtual disks, these virtual disks' container files don't ; need to be contiguous since all I/O is done via RMS block I/O 512 ; bytes at a time. No check is made that the disk is on the same machine ; with the driver, so virtual disks across DECnet may work. At any rate, ; nothing in here will prevent them from working. ; ; FDHOST/CLEAR will zero the ref. count only...nothing more. ; Note deassign normally will NOT be via command (I don't see how a ; command could ever be read) but vie exit AST. ; The expectation is that an fd: unit being assigned will have FDHOST/CLEAR run ; on the FD: unit before assigning it if the unit was set incorrectly. ; 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 DFAB_BLK: $FAB FNM=,XAB=FNXAB,FAC=,DNM=,rfm=fix,mrs=512 DRAB_BLK: $RAB FAB=DFAB_BLK,BKT=0,UBF=RECBUF,USZ=512 RECBUF: .BLKL 128 ;512 BYTES = 128 LONGS ; FNXAB: $XABFHC ; XAB STUFF TO GET LBN, SIZE .BLKL 20 ;SAFETY .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. ; MBCHN: .long 0 ; channel for mailbox MBUCB: .long 0 ; UCB address for mailbox CLRDS: .ASCID /CLEAR/ KEYDS: .ASCID /KEY/ ;CRYPTO KEY ;ASDSC: .ASCID /ASSIGN/ ;DASDSC: .ASCID /DEASSIGN/ P1DSC: .ASCID /UNIT/ P2DSC: .ASCID /FNAM/ .EVEN ; DESCRIPTOR FOR DVn:DSKFIL "FILENAME" .ALIGN LONG DDFNM: .WORD 255. ;LENGTH DDFTP: .BYTE DSC$K_DTYPE_T ;TEXT TYPE .BYTE 1 ; STATIC STRING DDFNA: .ADDRESS DDFNMD DDFNMD: .BLKB 256. ; DATA AREA DDCHN: .LONG 0 ; ; Data area for "disk" ; .align long fd_cyl=5 ;make it 5 cyls of 64 blocks each fd_blocks=fd_cyl*64 ; blocks... fd_longs=fd_blocks*128 ; longwords needed ;fd_data:: ; .BLKL fd_longs ; .blkl 128 ;guard area for safety during debug... ; ucb data area HSTUCB: .LONG 0 ;HOST UCB ADDRESS ;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 BUF: .BLKL 8192. ; DATA AREA .LONG 0,0 ;SAFETY BUFFERS SETFD: .LONG 0 ;DECLARE PROCESS .LONG 0 ;PID HSTFZ: .LONG 1 ;DISK SIZE .LONG 0,0,0,0 ;EXTRA STUFF FOR OTHER CALLS SETFDL=.-SETFD .LONG 0,0,0,0,0 ;SAFETY HSTFSZ: .LONG 0 ;DISK SIZE ; .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$: clrl clrcnt ;flag clear count if 1 PUSHAB clrds ; 'CLEAR' CALLS #1,G^CLI$PRESENT ; IS /CLEAR USED? CMPL R0,#CLI$_PRESENT ; IF EQ YES BNEQ 293$ incl clrcnt ; FLAG CLEARING USAGE BRW 295$ ;ON CLEAR DON'T BOTHER WITH 2ND FILENAME 293$: PUSHAB WRK ; GET 2ND FILE (REAL FILE) LONGWORD FOR LEN PUSHAB DDFNM ; & ITS DESCRIPTOR PUSHAB P2DSC ; & PARAMETER NAME 'P2' CALLS #3,G^CLI$GET_VALUE ; GET FNM ON_ERR fdhostd_EXIT ; $ASSIGN_S - ; Get a channel to the ; DEVNAM=DDFNM,- ; device for host file ; CHAN=DDCHN ; ON_ERR fdhostd_EXIT ; OPEN THE FILE, CHECK ITS INITIAL LBN ; IF ERROR OR NOT CONTIG, EXIT... ; DO VIA OPENING FILE AND READING ITS' STATBLOCK VIA ; QIO... ; SET UP FOR FILENAME WE REALLY FOUND IN FAB... MOVL DDFNA,DFAB_BLK+FAB$L_FNA ;SET UP FILENAME ADDR MOVB DDFNM,DFAB_BLK+FAB$B_FNS ;AND LENGTH $OPEN FAB=DFAB_BLK BLBC R0,149$ ; FAILURE IF FILE WON'T OPEN ; FNXAB HAS INFO ON LBN, SIZE ; MOVL FNXAB+XAB$L_SBN,HSTLBN ; GET HOST'S LBN (0 IF NON CONTIG.) MOVL FNXAB+XAB$L_HBK,HSTFSZ ; GET FILE SIZE. (CHECK THAT BELOW) DECL HSTFSZ ;;;COUNT DOWN 1 TO ACCOUNT FOR BOOT BLOCK BICL2 #63,HSTFSZ ;;;MAKE A MULTIPLE OF 64 BLKS MOVL HSTFSZ,HSTFZ ;FILE SIZE $CONNECT RAB=DRAB_BLK ;FINISH OPEN BLBC R0,149$ ; FAILURE IF FILE WON'T OPEN 295$: ; 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$ 149$: BRW FDHostd_EXIT 140$: tstl clrcnt bneq 162$ ;if just clearing ref count, no need for mbx ; 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$ 161$: BRW FDHostd_EXIT 176$: ; Got now the actual device name of the mailbox ; 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 ; 162$: $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! tstl clrcnt bneq 161$ ;exit now if just zeroing count MOVL OURPID,SETFD+4 ;STORE PID (IPID!!!) movl HSTFSZ,setfd+8 ;size of disk (preset also) movl mbucb,setfd+12 ; Comm mailbox UCB address CLRL SETFD ; flag that this is the setup movl #setfdl,r4 ; length of buffer ; 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 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 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 #3,SETFD ;GET DATA MOVL #BUFHDR,SETFD+4 ;BUFFER HDR ADDRESS movl #1,setfd+12 ;success indicator movl #setfdl,r4 $qiow_s efn=#1,chan=vdchn, - iosb=#iosb,func=#,p1=setfd,p2=R4 ON_ERR FDHostD_EXIT ; SKIP OUT IF ERROR ; $qiow_s efn=#1,chan=vdchn,func=#io$_format,p1=#setfd,p2=#setfdl ; LOADS DATA INTO LOCAL BUFFER FROM DRIVER ; NOW HAVE TO MOVE IT INTO STORAGE HERE MOVL BUFHDR+4,R0 ;GET BLOCK NUMBER INCL R0 ;MAP TO VBN MOVL R0,DRAB_BLK+RAB$L_BKT ;SET IT UP movw #512.,drab_blk+rab$w_rsz ;512 byte blks ; LOOP OVER BLKS IN REQUEST ; MOVAB RECBUF,R4 ; movl bufhdr+8,r6 ;get bytecount to move addl2 #511,r6 ;round up ashl #-9,r6,r6 ;convert to blks ; r6 is not messed up by movc3... movab buf,r7 ;scratch buffer address 15$: movab recbuf,r0 ;data to here movl r7,r2 ;data from here MOVC3 #512,(r2),(R0) ; STORE THE DATA IN OUR SPACE $write rab=drab_blk ON_ERR FDHostD_EXIT ; SKIP OUT IF ERROR addl2 #512,r7 ;pass this blk's data incl drab_blk+rab$l_bkt ;pass this blk in file too decl r6 ;count down blks to do bgtr 15$ ;copy all blks JMP COMMON READOP: ; READING DATA TO CLIENT. MUST GET DATA, THEN SEND TO DRIVER. MOVL BUFHDR+4,R0 ;GET BLOCK NUMBER INCL R0 ;MAP TO VBN MOVL R0,DRAB_BLK+RAB$L_BKT ;SET IT UP movw #512.,drab_blk+rab$w_rsz ;512 byte blks ; LOOP OVER BLKS IN REQUEST ; MOVAB RECBUF,R4 ; movl bufhdr+8,r6 ;get bytecount to move addl2 #511,r6 ;round up ashl #-9,r6,r6 ;convert to blks ; r6 is not messed up by movc3... movab buf,r7 ;scratch buffer address 16$: $read rab=drab_blk ON_ERR FDHostD_EXIT ; SKIP OUT IF ERROR movab recbuf,r2 ;data to here movl r7,r0 ;data from here MOVC3 #512,(r2),(R0) ; STORE THE DATA IN OUR SPACE addl2 #512,r7 ;pass this blk's data incl drab_blk+rab$l_bkt ;pass this blk in file too decl r6 ;count down blks to do bgtr 16$ ;copy all blks movab buf,r2 ADDL3 #20,BUFHDR+8,SETFD+8 ; GET LENGTH TO XFER MOVL #BUFHDR,SETFD+4 ;BUFFER HDR ADDRESS MOVL #2,SETFD ;HOST TO DRIVER COPY 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... $DASSGN_S CHAN=VDCHN RET FDHostd_exit: 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 tstl clrcnt ;;;just zeroing count? bneq 126$ 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 126$: 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.) ; ; Set device size. Since this is true of any disk, just use the offsets. ; No need for duplicating the UCB defs here. tstl clrcnt ;;;just zeroing use count beql 127$ ;;;if eql, no, normal ops movw #1,ucb$w_refc(r1) ;;;zero ref count (in case it got set -1) ;;; (note we set it to 1 so it decrements to 0 on our exit.) BICW #UCB$M_ONLINE,UCB$W_STS(R1) ;;; FLAG OFFLINE BICW #UCB$M_VALID,UCB$W_STS(R1) ;;; AND VOL INVALID brb 128$ ;;;exit, success 127$: ; tstw ucb$w_refc(r1) ;;;fix up stray ref counts bneq 140$ ;;; 142$: movw #1,ucb$w_refc(r1) ;;;if it was 0, keep from getting 65535 brb 141$ 140$: cmpw ucb$w_refc(r1),#65533 ;;;small neg numbers also look bugus bgtru 142$ ;;;so fix these up also 141$: MOVL HSTFSZ,UCB$L_MAXBLOCK(R1) ;;; (SAVE SIZE TWICE, FOR RMS MOVL HSTFSZ,R0 ;;; GET HOST SIZE IN CYLINDERS ASHL #-6,R0,R0 ;;; GET # CYLINDERS IN SIZE NOW 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. 128$: 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 CLRCNT: .long 0 ;1 if clearing ref cnt ucb$w_refc ;;;(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$_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. RET ; FINISH EXIT .END FDHostD