program REMHST
c FDHOSTREMOT remote host program. This program is fired up in
C response to FDHOSTREM opening a DECnet channel to it on a known
C object and is expected to be privileged (at least log_io) so it
c can act as the remote access method to a disk physically located
c somewhere across a DECnet from the other host. (Local connections
c are of course possible as well, but a horrible WASTE and useful
c really only for testing and demonstrations of virtuosity.)
c and for performing initial QIO to get device sizes.
	INTEGER*4 NETCHN,NETTRK,NETSCT,NETCYL,NETBLK
C opens channel to sys$net, does initial sizing and writes to it.
C Use trnlog for now since it's easier to do...
C Translates logical name FDRDSK to get the device name and uses the
C $getdvi system service to find out the size and physical parameters
C of the device so assigned. Opens a channel to the disk and to sys$net
C and sends a message containing the trks,sectors,cylinders,blks of the
C device back to the sys$net channel. It then must read the net (with
C a size of at least 8192+24 bytes) and interprets the buffer header
C to send back either data alone, or just the IO status block. If the
C data it read was from a write from client to FD:, it must just send
C the 8 bytes of IOSB of the transfer back. (This will normally be
C 1/bytes sent in longword 1 and 0 in longword 2). If the data read
C from the host was a read request, it must send the desired data
C back, after reading it from the local device FDRDSK (FD: Remote DiSK).
c
c
c  Diagram of the connectivity envisioned here:
c
c               <-decnet->
C +-------------+       +--------------+   +----------+   +------------+
C | FDREMHOST   |       | FDHOSTREM    |   | FDDRV    |   | Client prog|
C |   .FOR      |<---   |   .MAR       |   |  .MAR    |   | (uses FD:) |
C | (This prog) |   /   | +fdremsub.for|<->| driver   |<->|            |
C |             |   --->|              |   |          |   |            |
C +-------------+       +--------------+   +----------+   +------------+
c      Machine 1			Machine 2

	INCLUDE '($DVIDEF)'
	INCLUDE '($IODEF)'
	Integer*4 lib$sys_trnlog,sys$assign,sys$qiow,SYS$GETDVIW
	External lib$sys_trnlog,sys$assign,sys$qiow,SYS$GETDVIW
	Character*80 DskDvc
	Integer*4 Status,IDKDL,DSKCHN,I4WRK
	Integer*4 Sizes(4)
C DATA BUFFER AREA
	INTEGER*4 DBF(2076)
C I/O STATUS BLOCKS
	INTEGER*2 IOSBRM(4)
	INTEGER*2 IOSBLO(4)
	INTEGER*4 IOSR(2),IOSL(2)
	EQUIVALENCE(IOSBRM(1),IOSR(1)),(IOSBLO(1),IOSL(1))
C REMOTE AND LOCAL I/O STAT BLKS (NET AND DISK DEVICES RESPECTIVELY)
	INTEGER*2 WRKIOS(4)
C WORK IOSB.
C HEADER IS FIRST 4 LONGWORDS
C BUFFER IS THE REST (PLUS A LITTLE SLOP)
C ITEM LIST FOIR GETDVI
	INTEGER*2 DVII2(6,5)
	INTEGER*4 DVIITM(3,5)
	EQUIVALENCE(DVII2(1,1),DVIITM(1,1))
C  BUF LENGTH, ITEM CODE - 1ST 2 WORDS
C  BUFFER ADDRESS
C  RETURN LENGTH ADDRESS  - NEXT 2 LONGWORDS, EACH ITEM (4 IN ALL)
C TERMINATE GETDVI ITEMLIST
	DVIITM(1,5)=0
	DVIITM(2,5)=0
	DVIITM(3,5)=0
C FIRST ITEM - DISK SIZE
	DVII2(1,1)=4
	DVII2(2,1)=DVI$_MAXBLOCK
	DVIITM(2,1)=%LOC(SIZES(4))
	DVIITM(3,1)=%LOC(I4WRK)
C SECOND ITEM - NUMBER OF TRACKS
	DVII2(1,1)=4
	DVII2(2,1)=DVI$_TRACKS
	DVIITM(2,1)=%LOC(SIZES(1))
	DVIITM(3,1)=%LOC(I4WRK)
C THIRD ITEM - NUMBER OF SECTORS
	DVII2(1,1)=4
	DVII2(2,1)=DVI$_SECTORS
	DVIITM(2,1)=%LOC(SIZES(2))
	DVIITM(3,1)=%LOC(I4WRK)
C FOURTH ITEM - NUMBER OF CYLINDERS
	DVII2(1,1)=4
	DVII2(2,1)=DVI$_CYLINDERS
	DVIITM(2,1)=%LOC(SIZES(3))
	DVIITM(3,1)=%LOC(I4WRK)
C
	netblk=0
	netchn=0
c Zero in channel indicates failure
c First translate the logicals
C ALLOW NOWRITE LOGICAL, IF PRESENT, TO DISABLE WRITING BY REMOTE
	IWRTOK=1
	STATUS=LIB$SYS_TRNLOG('NOWRITE',IDKDL,DSKDVC)
	IF(STATUS)IWRTOK=0
	Status=lib$sys_trnlog('FDRDSK',IDKDL,DskDvc)
	if(.not.status)CALL SYS$EXIT(%VAL(2))
C ASSIGN A CHANNEL TO THE NAMED DISK.
	STATUS=SYS$ASSIGN(DSKDVC(1:IDKDL),DSKCHN,,)
	if(.not.status)CALL SYS$EXIT(%VAL(2))
C OPEN THE NETWORK CHANNEL TO OUR PARTNER...
	status=sys$assign('SYS$NET',NETCHN,,)
	if(.not.status)CALL SYS$EXIT(%VAL(2))
C NOW GET HOLD OF SIZE INFO
	SIZES(1)=0
	STATUS=SYS$GETDVIW(%VAL(2),%VAL(DSKCHN),,DVIITM,,,,)
	if(.not.status)CALL SYS$EXIT(%VAL(2))
C SEND OUT THE INITIAL PACKET OF INFORMATION ON OUR SIZE TO THE OTHER SIDE.
	IF(SIZES(1).EQ.0)CALL SYS$EXIT(%VAL(4))
	STATUS=SYS$QIOW(%VAL(1),%VAL(NETCHN),%VAL(IO$_WRITEVBLK),
     1  ,,,SIZES,%VAL(16),,,,)
	if(.not.status)CALL SYS$EXIT(%VAL(2))
C SIZES ARRAY now contains the t/s/c/b stuff
	netblk=sizes(4)
	nettrk=sizes(1)
	netsct=sizes(2)
	netcyl=sizes(3)
C NOW ENTER OUR NORMAL EVENT LOOP.
100	CONTINUE
C READ OUR BUFFER AND INTERPRET. RETURN I/O STATUS CODE OF
C OUR LOCAL OPERATIONS TO REMOTE AFTER DOING WHAT'S
C NEEDED.
C  BUFFER HEADER STRUCTURE
C  DIRECTION - 0 IF CLIENT READ (WE READ DISK,WRITE NET)
C		OR 1 IF CLIENT WRITE (WE READ NET, WRITE DISK)
C
C  BLOCK NUMBER OF START BLOCK OF TRANSFER
C  BYTES TO TRANSFER
C  I/O STATUS BLOCK LONGWORD 1
C  I/O STATUS BLOCK LONGWORD 2
C HANG OUR READ ON THE NET...
	IF(SIZES(1).EQ.0)CALL SYS$EXIT(%VAL(4))
	STATUS=SYS$QIOW(%VAL(1),%VAL(NETCHN),%VAL(IO$_READVBLK),
     1  IOSBRM,,,DBF,%VAL(8220),,,,)
	if(.not.status)GOTO 9999
C NOW WE HAVE BUFFER HEADER LOCAL AT LEAST.
	IF(DBF(1).EQ.0)GOTO 1000
C CLIENT WRITE... WE JUST READ NET, NOW WRITE TO DISK AND THEN RETURN STATUS
C SANITY CHECK SIZE.
	IF(DBF(3).LE.0.OR.DBF(3).GT.8220)GOTO 9999
C SKIP THIS IF WRITE IS DISABLED AT THIS HOST VIA NOWRITE LOGICAL NAME DEFINED
	IF(IWRTOK.EQ.0)GOTO 300
	STATUS=SYS$QIOW(%VAL(1),%VAL(DSKCHN),%VAL(IO$_WRITELBLK),
     1  IOSBLO,,,DBF(6),%VAL(DBF(3)),%VAL(DBF(2)),,,)
	if(.not.status)GOTO 9999
C NOW HAVE THE DATA WRITTEN TO DISK HERE, SO FILL IN THE IOSB AND
C RETURN A STATUS TO NET PARTNER
	IOSR(1)=IOSL(1)
	IOSR(2)=IOSL(2)
300	CONTINUE
	DBF(6)=IOSR(1)
	DBF(7)=IOSR(2)
	STATUS=SYS$QIOW(%VAL(1),%VAL(NETCHN),%VAL(IO$_WRITEVBLK),
     1  IOSBRM,,,DBF(6),%VAL(8),,,,)
	if(.not.status)GOTO 9999
C NOW STATUS IS REPORTED. BACK TO LOOP FOR ANOTHER EVENT.
	GOTO 2000
1000	CONTINUE
C CLIENT READ...WE READ DISK, WRITE TO NET.
	STATUS=SYS$QIOW(%VAL(1),%VAL(DSKCHN),%VAL(IO$_READLBLK),
     1  IOSBLO,,,DBF(6),%VAL(DBF(3)),%VAL(DBF(2)),,,)
	if(.not.status)GOTO 9999
C GOT THE DATA INTO OUR BUFFERS. NOW DUMP IT BACK AT THE HOST.
C FIRST FILL IN RETURN IOSB
	DBF(4)=IOSL(1)
	DBF(5)=IOSL(2)
	ISZ=DBF(3)+20
	STATUS=SYS$QIOW(%VAL(1),%VAL(NETCHN),%VAL(IO$_WRITEVBLK),
     1  IOSBRM,,,DBF,%VAL(ISZ),,,,)
	if(.not.status)GOTO 9999
C NOW ALL DATA IS SHOVED BACK TO HOST AT OTHER MACHINE. GO BACK FOR MORE
2000	CONTINUE
C COMMON PROCESSING WOULD GO HERE BUT NOTHING COMES TO MIND FOR NOW.
C THEREFORE JUST GO GET MORE WORK.
	GOTO 100
C ERROR EXIT...CLOSE CHANNELS AND SCRAM.
9999	CONTINUE
	STATUS=SYS$DASSGN(%VAL(NETCHN))
	STATUS=SYS$DASSGN(%VAL(DSKCHN))
	CALL SYS$EXIT(%VAL(1))
	END