	PROGRAM XDATCH
C
C UTILITY PROGRAM FOR VIRTUAL DEVICE DRIVER
C
C D.STAGG   MARCH 1981
C
C REFERENCE - PROCEEDINGS OF DECUS VOL 7, #2 FALL 1980 P639.
C
C THERE ARE FOUR COMMANDS AVAILABLE:
C
C DEV:FNAME.EXT=XDn:  TO ASSIGN XD UNIT n TO A FILE
C XDn:/Q              TO QUERY THE ASSIGNMENT OF XD UNIT n
C XDn:/D              TO REMOVE THE ASSIGNMENT OF XD UNIT n
C /T                  TO DUMP THE XD DEVICE TABLES
C
C THE FOLLOWING MOD IS REQUIRED FOR DUP.SAV (V4 RT11)
C
C R SIPP
C SY:DUP.SAV
C 1<CR>, 30<CR>, 10223<CR>
C 377<CR>, ^Y<CR>
C ^C
C
C THE IMPLEMENTATION IS SIMILAR TO THAT DESCRIBED IN THE DECUS
C PROCEEDINGS, WITH THE SAME RESTRICTIONS.
C IF SIMULTANEOUS REQUESTS ARE MADE TO THE XD DRIVER FROM FG AND BG,
C FOR EXAMPLE, THE REQUESTS ARE QUEUED ON A LAST COME, LAST SERVED
C BASIS IN THE SAME WAY AS FOR THE SJ MONITOR.
C THE XD DEVICE HAS BEEN IMPLEMENTED AS DEVICE 377 WHICH MAY BE
C BE CHANGED IN THE CALL TO .DRDEF IN XD.MAC. REMEMBER TO CHANGE
C THE CORRESPONDING 377 IN THE DUP.SAV MOD.
C
	IMPLICIT INTEGER (A-Z)
	INTEGER XD,CBLK(4),FILSPC(39),DEFEXT(4),SWITCH(4,3)
	INTEGER ISPEC(4),OSPEC(4),SBLOK(5),DUPSPC(4)
	BYTE STRING(20),IB(2),BRAY(512)
	EQUIVALENCE(FILSPC(16),ISPEC),(FILSPC,OSPEC)
	EQUIVALENCE(IB,SBLOK(5))
C
	DATA XD /3RXD0/,DEFEXT /0,3RDEV,0,0/
	DATA SWITCH (1,1)/'D'/,SWITCH(1,2)/'Q'/,SWITCH(1,3)/'T'/
	DATA DUPSPC,BRAY /3RSY ,3RDUP,3R   ,3RSAV,512*0/
C
	ICHAN=IGETC(0)
C FIRST CHECK WHETHER DUP HAS BEEN PATCHED
	IF(LOOKUP(ICHAN,DUPSPC).GT.0)GO TO 10
	TYPE 500
500	FORMAT(' ** WARNING - SY:DUP.SAV NOT ACCESSIBLE **'/)
	GO TO 40
10	IF(IREADW(256,BRAY,"11,ICHAN).NE.256)GO TO 20
	IF(BRAY("204).EQ."377)GO TO 30
20	TYPE 510
510	FORMAT(' ** WARNING - ? SY:DUP.SAV NOT PATCHED ? **'/)
30	CALL IFREEC(ICHAN)
C
40	IF(IDSTAT(XD,CBLK).EQ.0)GO TO 60
50	STOP 'XD HANDLER NOT RESIDENT'
C XDADDR IS ADDRESS OF 4TH WORD OF HANDLER
60	XDADDR=CBLK(3)
	IF(XDADDR.EQ.0)GO TO 50
C TBADDR IS ADDRESS OF HANDLER TABLE
	TBADDR=XDADDR-4+IPEEK(XDADDR-4)
C
70	I=ICSI(FILSPC,DEFEXT,,SWITCH,3)
	IF(I.EQ.0)GO TO 80
	TYPE 520
520	FORMAT('+ICSI ILLEGAL INPUT'/)
	GO TO 70
80	IF(SWITCH(2,3).NE.0)GO TO 160
C THERE MUST BE AN INPUT FILE OF TYPE XDn
	UNIT=ISPEC(1)-XD
	IF(UNIT.EQ.-"36)UNIT=0
	IF(UNIT.GE.0.AND.UNIT.LE.7)GO TO 90
	TYPE 530
530	FORMAT('+INPUT FILESPEC MISSING'/)
	GO TO 70
90	IF(SWITCH(2,1).NE.0)GO TO 180
	IF(SWITCH(2,2).NE.0)GO TO 200
C IF NO SWITCHES ON, MUST BE AN ASSIGNMENT
	IF(IDSTAT(OSPEC,CBLK).EQ.0)GO TO 110
100	TYPE 540
540	FORMAT('+OUTPUT FILESPEC ERROR'/)
	GO TO 70
110	IF(CBLK(3).NE.0)GO TO 120
	CALL R50ASC(3,OSPEC,STRING)
	STRING(4)=(1H:)
	STRING(5)=0
	CALL TRIMS(STRING)
	TYPE 550,(STRING(I),I=1,LEN(STRING)),"15,"12
550	FORMAT('+HANDLER NOT RESIDENT ',6A1)
	GO TO 70
C SEE IF XD SPECIFIED AS OUTPUT FILE
120	CALL ASLOOK(OSPEC,OSPEC,I)
	I=OSPEC(1)-XD
	IF(I.LT.0.OR.I.GT.7)GO TO 130
	TYPE 560
560	FORMAT('+RECURSIVE ASSIGNMENT NOT ALLOWED !!'/)
	GO TO 70
130	CALL FTRAN(OSPEC,STRING)
	CALL GETFIL(OSPEC,STRING,DEFEXT,IRET)
	CALL FTRAN(OSPEC,STRING)
	IF(IRET.NE.-1.AND.IRET.NE.-2)GO TO 140
	TYPE 570
570	FORMAT('+FILE NOT FOUND'/)
	GO TO 70
140	IF(IRET.LE.0)GO TO 100
	I=LOOKUP(ICHAN,OSPEC)
	I=ISAVES(ICHAN,SBLOK)
	IL=TBADDR+16*UNIT
C STORE HANDLER LOAD ADDRESS
	CALL IPOKE(IL,CBLK(3))
C STORE STARTING BLOCK OF FILE
	CALL IPOKE(IL+2,SBLOK(2))
C STORE LENGTH OF FILE
	CALL IPOKE(IL+4,IRET)
C STORE ASSIGNED FILE DEVICE UNIT NUMBER
	IUNIT=IB(2)
	CALL IPOKE(IL+6,IUNIT)
C STORE FILE NAME
	IL=IL+8
	DO 150 I=1,4
	CALL IPOKE(IL,OSPEC(I))
150	IL=IL+2
	GO TO 70
C
C DUMP XD TABLES
160	DO 170 I=0,7
	TYPE 580,I,(IPEEK(16*I+J+TBADDR),J=0,14,2)
580	FORMAT(1X,I1,1X,8O7)
170	CONTINUE
	TYPE 590
590	FORMAT(1X)
	GO TO 70
C
C COMMAND WITH '/D'
180	IL=TBADDR+16*UNIT
	DO 190 I=0,14,2
190	CALL IPOKE(IL+I,0)
	GO TO 70
C COMMAND WITH '/Q'
200	IL=TBADDR+16*UNIT+8
	DO 210 I=1,4
	OSPEC(I)=IPEEK(IL)
210	IL=IL+2
	IF(OSPEC(1).NE.0)GO TO 220
	TYPE 600
600	FORMAT('+UNIT NOT ASSIGNED'/)
	GO TO 70
220	CALL FTRAN(OSPEC,STRING)
	TYPE 610,(STRING(I),I=1,LEN(STRING)),"15,"12
610	FORMAT('+UNIT ASSIGNED TO ',16A1)
	GO TO 70
C
	END
