PROGRAM DPU
CC
C	DSKPAT - DISK PATCH UTILITY.
C
	IMPLICIT INTEGER(A-Z)
	INCLUDE '[214,10]BUFCOM.COM'
	INCLUDE '[214,10]INPCOM.COM'
	PARAMETER   CMDL=8,NCMD=9
	PARAMETER	MXFLNM=40	! MAXIMUM FILE NAME LENGTH
	INTEGER*2	PRL(6)
	LOGICAL	VERIFY
	LOGICAL*1   CMDS(CMDL,NCMD)
	LOGICAL*1   COMAND(30)		!   COMMAND BUFFER
	LOGICAL*1	FILNAM(MXFLNM)
	DATA IORVB,IOWVB,IORLB,IOWLB/"10400,"11000,"1000,"400/
	DATA  IOATT,SFGMC/"1400,"2560/
	DATA	LUN/1/		! USE LUN 1 FOR I/O
	DATA CMDS/
	1	2,'R','V', 0 , 0 , 0 , 0 , 0
	1,	2,'W','V', 0 , 0 , 0 , 0 , 0
	1,	2,'R','L', 0 , 0 , 0 , 0 , 0
	1,	2,'W','L', 0 , 0 , 0 , 0 , 0
	1,	1,'O','P','E','N', 0 , 0 , 0 
	1,	2,'R','E','W','R','I','T','E'
	1,	1,'C','H','E','C','K', 0 , 0
	1,	2,'R','H', 0 , 0 , 0 , 0 , 0
	1,	1,'F','H', 0 , 0 , 0 , 0 , 0
	1/
	CALL	WTQIO(IOATT,5,1)		! ATTACH TERMINAL
	CALL	GETADR(PRL(1),COMAND(1))
	PRL(2) = 2
	COMAND(1) = "51
	COMAND(2) = 0
	CALL	WTQIO(SFGMC,5,1,,,PRL)	! ISSUE THE REQUEST
	IF(COMAND(2).NE.1) GOTO 9099
CC
C	COMMAND DISPATCHER.
C
100	I = GETSTR('DPU>')		!   DISPLAY PROMPT AND GET COMMAND
	IF (TTYEOF)   CALL EXIT
	ITERM = NXTARG(COMAND)		!   GET TERMINATOR AND NEXT ARG
	IF (ITERM.LT.0)   GOTO 100	!   IF BLANK ENTRY
	IERR = ICONV(COMAND,IVAL)
	IF (IERR)   6000,105,800	!   OK, NON NUMERIC, ILL DIG
105	ICMD = FNDCMD(COMAND,CMDS,NCMD,CMDL)	!   SEARCH COMMAND TABLE
	IF (ICMD)   106,107,110		!   ILLEGAL, AMBIG, OK
106	TYPE 9000
9000	FORMAT(' Illegal command!')
	GOTO 100			!   TRY AGAIN
107	TYPE 9010
9010	FORMAT(' Ambiguous command.')
	GOTO 100
110	GOTO (1100,1200,1300,1400,1500,1600,1700
	1,1800,1900), ICMD !   DISPATCH THE COMMAND
	TYPE 9100, ICMD
9100	FORMAT(' COMMAND=',I5)
	GOTO 100			!   BOGUS COMMAND SEARCH
CC
C	RV - READ VIRTUAL BLOCK
C
1100	CONTINUE
	BLKTYP = RWV		! INDICATE R/W AS VIRTUAL
	I = IGBN(BLKNH,BLKNL)	! GET THE BLOCK NUMBER
D	TYPE 9019,BLKNH,BLKNL
D9019	FORMAT(' BLKNH =',O6,'  BLKNL =',O6)
	CALL RW(IORVB,LUN)	! READ THE BLOCK
	GOTO 6150
CC
C	WV - WRITE VIRTUAL BLOCK
C
1200	CONTINUE
	I = IGBN(BLKNH,BLKNL)	! GET THE VIRTUAL BLOCK NUMBER
	CALL RW(IOWVB,LUN)	! WRITE THE BLOCK
	GOTO 100
CC
C	RL - READ LOGICAL BLOCK
C
1300	CONTINUE
	BLKTYP = RWL		! INDICATE R/W AS LOGICAL
	I = IGBN(BLKNH,BLKNL)	! GET THE LOGICAL BLOCK NUMBER
	CALL RW(IORLB,LUN)	! READ THE BLOCK
	GOTO 6150
CC
C	WL - WRITE LOGICAL BLOCK
C
1400	CONTINUE
	I = IGBN(BLKNH,BLKNL)	! GET THE LOGICAL BLOCK NUMBER
	CALL RW(IOWLB,LUN)	! READ THE BLOCK
	GOTO 100
CC
C	OPEN - OPEN A FILE
C
1500	CONTINUE
	CALL CLOSE(LUN)
	I = GFN(FILNAM,MXFLNM,INPUT,INPTR,INCNT)
	IF(I.EQ.-1) GOTO 1510	! BRIF HE SPECIFIED A FILE NAME
	I = FILNAM(3)		! GET THE UNIT SPECIFIER
D	TYPE 9123,I
D9123	FORMAT(' UNIT NUMBER =',I3)
	CALL	ASNLUN(LUN,FILNAM,I)	! ASSIGN THE LUN
	GOTO 100
1510	OPEN(UNIT=LUN,NAME=FILNAM,TYPE='OLD',ACCESS='SEQUENTIAL'
	1,FORM='UNFORMATTED')
C	READ(LUN,ERR=1520,END=1520)I
1520	GOTO 100
CC
C	REWRITE - WRITE BLOCK BACK TO LAST BLOCK
C
1600	CONTINUE
	IF(BLKTYP.EQ.RWV) IOFNC = IOWVB	! SET IO FUNCTION CODE
	IF(BLKTYP.EQ.RWL) IOFNC = IOWLB	! ACCORDING TO BLKTYP
	CALL	RW(IOFNC,LUN)		! WRITE IT BACK OUT
	GOTO 100
CC
C	CHECK - CHECKSUM THE BLOCK
C
1700	CONTINUE
	I = NXTARG(FILNAM)	! GET WHETHER IT IS A FILE HEADER OR HOME BLOCK
	FILNAM(1)=FILNAM(1).AND..NOT."40
	I = INDEX('HF',FILNAM)	! SEE IF HE TYPE CORRECT THING
	IF(I.NE.0) GOTO 1750	! IF LEGAL TYPE
	TYPE 1740
1740	FORMAT(' Unrecognized checksum type!')
	GOTO 100
1750	CTYPE = I-1		! SET THE TYPE
	I = NXTARG(FILNAM)	! SEE IF HE WANTED ONLY TO VERIFY THIS
	VERIFY = .FALSE.	! ASSUME FALSE
	I = INDEX('VW',FILNAM)
	IF(I.NE.0) GOTO 1760		! BRIF EITHER WRITE OR VERIFY
	TYPE 1799
1799	FORMAT(' Please specify Verify or Write.')
	GOTO 100
1760	IF(I.EQ.1) VERIFY = .TRUE.	! IF HE SPECIFIED VERIFY
	CALL CHKSUM(CTYPE,VERIFY)
	GOTO 100
1800	CONTINUE	! READ HEADER
1900	CONTINUE	! FIND HEADER
	GOTO 100
C	I = NXTARG(*****1155*****)
CC
C	GENERAL ENTRY TO PROCESS WHEN FIRST ARG IS A NUMERIC
C
6000	CONTINUE
	IF (ITERM.EQ.0)   GOTO 6100	!   IF ENTERED ONLY A NUMBER
	I = INDEX('/\',ITERM)		!   CHECK FOR DISPLAY/CHANGE SINGLE
	IF (I.NE.0)   GOTO 6200		!   IF FOUND ONE
6100	CALL	DISP(IVAL/2+1)
	GOTO 100			!   PROCESS NEXT COMMAND
6150	IVAL = 0
	GOTO 6100
CC
C	PROCESS SINGLE WORD/BYTE INSPECT/CHANGE
C
6200	ITERM = NXTARG(FILNAM)		!   GET POSSIBLE NUMBER
	IF (ITERM.LT.0)   GOTO 6400	!   IF NO NUMBER THERE
	IERR = ICONV(FILNAM,ITERM)	!   GET NUMERIC VALUE
	IF (IERR.GE.0)   GOTO 800		!   IF NO GOOD
	IF (I.EQ.1)   BUFF(IVAL/2+1) = ITERM	!   IF CHANGING WORD
	IF (I.EQ.2)   BUFFB(IVAL+1) = ITERM	!   DITTO BYTE
	GOTO 100
CC
C	ITS AN INSPECT
C
6400	TYPE 6410
6410	FORMAT(' Unimplemented option #77b!')
	GOTO 100
CC
C	GENERAL ENTRY TO PROCESS ERRORS RETURNED BY *ICONV*
C
800	GOTO (810,820), IERR+1
	TYPE 8000, IERR
8000	FORMAT(' Unknown error',I5)
	GOTO 100
810	TYPE 8001
8001	FORMAT(' Non numeric arg where numeric required.')
	GOTO 100
820	TYPE 8002
8002	FORMAT(' Illegal digit for constant type.')
	GOTO 100
9099	TYPE 9901
9901	FORMAT(' Use:  RUN $DSKPAT')
	CALL	EXIT
	END