.TITLE	PATCH
	.SBTTL	HANDLE PATCHES TO A CORE IMAGE
;***********************************************************************
;
;	PATCH A CORE IMAGE
;
;***********************************************************************
PATCH::	CALL	INDEXC			;CREATE A REGION TO USE
	MOV	#INXARY,R1		;ADDRESS OF REGION
	MOV	#10000,R2		;LENGTH
	CALL	BLANK			;CLEAR IT
	OPEN$R	#PRIINP,,,,,,PRIERR	;OPEN THE INPUT CIL
	MOV	#INXARY,F.BKDS+2(R0)	;READ INTO THE REGION
	CALL	READ			;READ THE 1ST BLOCK OF INDEX
	MOV	#INXARY,R1		;PTR TO BUFFER
	CMP	#1,(R1)+		;DID WE GET A CIL OR LICIL?
	BEQ	.+6			;OKAY SO FAR
	JMP	UNDERR			;ERROR IF NOT CIL
	CMPB	#3,4(R1)		;DEFINITELY A CIL?
	BEQ	.+6			;YES
	JMP	UNDERR			;ERROR IF NOT A CIL
	MOV	22(R1),OUTCIL+F.CNTG	;OPEN CONTIGUOUS
	OPEN$W	#OUTCIL,,,,,,CONERR	;OPEN THE OUTPUT CIL
	MOV	22(R1),CILBK1		;SAVE TOTAL # OF BLOCKS FOR LATER
	MOV	20(R1),R1		;GET # OF BYTES IN INDEX
	ADD	#777,R1			;ROUND UP
	ASH	#-9.,R1			;CALC # OF BLOCKS IN INDEX
	MOV	R1,INXSIZ		;SAVE FOR LATER
	SUB	R1,CILBK1		;SAVE # OF BLOCKS USED BY CORE IMAGES
	DEC	R1			;COUNT THE BLOCK JUST READ
	BLE	GETMOD			;ONLY ONE INDEX BLOCK
1$:	ADD	#BLKSIZ,F.BKDS+2(R0)	;NEW DESTINATION BUFFER
	CALL	READ			;READ A BLOCK OF INDEX IN
	SOB	R1,1$			;LOOP
	.PAGE
;	LOOK FOR THE "C <MODULE NAME>" COMMAND
GETMOD:	CALL	INPUT			;GET A COMMAND
GETCD2:	CMPB	#73,(R0)		;A COMMENT?
	BEQ	GETMOD			;IF TRUE, JUST IGNORE IT
	CMPB	#'E,(R0)		;END COMMAND?
	BNE	.+6			;NO
	JMP	RESTAR			;IF YES, WE MUST WANT OUT
	CMPB	#'C,(R0)+		;GOT THE DESIRED "C"?
	BEQ	.+6			;YES
	JMP	NOCERR			;ERROR IF NO CHANGE COMMAND
	DEC	R1			;COUNT THE C
	BGT	.+6			;OKAY IF STILL MORE
	JMP	SHTERR			;ERROR IF THAT'S ALL
	SKIP	40			;SKIP ANY SPACES
	MOV	#ARG,R3			;PLACE TO STORE MODULE NAME
	RAD50	R3,R1			;GET THE MODULE NAME
	RAD50	R3,R1			;
	MOV	INXARY+20,R3		;POINT TO # OF ENTRIES
	MOV	#INXARY+40,R1		;PTR TO 1ST ENTRY
;	GOT MODULE NAME TO CHANGE; SEE IF IT EXISTS
GOTMOD:	CMP	20(R1),ARG		;GOT A MATCH?
	BNE	1$			;NO
	CMP	22(R1),ARG2		;AN EXACT MATCH?
	BNE	1$			;NO
	MOV	R1,ARG5			;YES, SO SAVE THIS SPOT!
	BR	GETIDT			;NOW GET IDENT COMMAND
1$:	ADD	(R1)+,R1		;SKIP TO THE NEXT ENTRY
	SOB	R3,GOTMOD		;LOOP
	MOV	#ARG,R2			;IF HERE, NO MATCH FOUND
	CALL	MODNOT			;REPORT THE ERROR
	JMP	RESTAR			;RESTART
	.PAGE
GETIDT:	CALL	INPUT			;GET ANOTHER COMMAND
	CMPB	#73,(R0)		;COMMENT?
	BEQ	GETIDT			;TRY AGAIN IF SO
	CMPB	#'E,(R0)		;END COMMAND?
	BNE	.+6			;NO, CONTINUE
	JMP	RESTAR			;IF SO, JUST GET OUT
	CMPB	#'C,(R0)		;ANOTHER CHANGE COMMAND?
	BNE	.+6			;NO
	JMP	GETCD2			;YES, MUST WANT TO CHANGE MODULES
	CMPB	#'I,(R0)+		;IS IT THE "I" WE EXPECT?
	BEQ	.+6			;YES
	JMP	NOIERR			;REPORT THE ERROR
	DEC	R1			;COUNT THE I
	SKIP	40			;SKIP ANY SPACES
	CLR	ARG6			;ASSUME NO NEW IDENT
	MOV	#ARG3,R3		;STORAGE FOR THE IDENT
	RAD50	R3,R1			;GET THE IDENT
	RAD50	R3,R1			;
	CMPB	#':,(R0)+		;GOT A ":" TO SIGNIFY NEW IDENT?
	BNE	1$			;NO
	MOV	#ARG6,R3		;STORAGE FOR NEW IDENT
	RAD50	R3,R1			;GET NEW IDENT
	RAD50	R3,R1			;
1$:	MOV	ARG5,R1			;GET OUR INDEX ENTRY PTR BACK
	TST	24(R1)			;GOT AN IDENT?
	BEQ	3$			;NO, SO NO CHECK
	CMP	24(R1),ARG3		;CHECK FOR MATCH
	BNE	2$			;NO, ERROR
	CMP	26(R1),ARG4		;
	BNE	2$			;NO, ERROR
	BR	3$			;CONTINUE IF MATCH
2$:	JMP	NOMTCH			;NO MATCH IDENT ERROR
3$:	TST	ARG6			;NEW IDENT?
	BEQ	4$			;NO, SO NO UPDATE
	MOV	ARG6,24(R1)		;UPDATE THE IDENT
	MOV	ARG7,26(R1)		;
4$:	MOV	2(R1),LADR		;SAVE THE LOAD ADDRESS
	MOV	10(R1),SIZE		;CORE IMAGE SIZE
	CMP	MODSIZ,SIZE		;ARE GOING TO BE ABLE TO FIT IT?
	BGE	.+6			;YES
	JMP	SIZERR			;ERROR OTHERWISE
	MOV	16(R1),BLOCK		;LOGICAL BLOCK NUMBER
	INC	BLOCK			;
	MOV	ARG5,R4			;GET INDEX ENTRY PTR
	ADD	#30,R4			;POSITION US AT THE DATE WORD
	PUSH	ARG5			;SAVE
	CALL	GDATE			;GO GET A NEW DATE AND TIME
	POP	ARG5			;RECOVER
	MOV	SIZE,R3			;GET SIZE IN BYTES
	ADD	#777,R3			;ROUND UP
	MOV	R3,R5			;COPY IT
	ASH	#-9.,R3			;# OF BLOCKS
	BIC	#777,R5			;# OF BYTES ALLOWED
	ADD	LADR,R5			;DETERMINE UPPER ADDRESS RANGE
	.PAGE
	MOV	#PRIINP,R0		;FDB
	MOV	BLOCK,F.BKVB+2(R0)	;INIT WHERE TO READ FROM
	CLR	F.BKVB(R0)		;
	MOV	#INXARY+10000,F.BKDS+2(R0) ;INIT WHERE TO PUT IT
5$:	CALL	READ			;READ A BLOCK
	ADD	#BLKSIZ,F.BKDS+2(R0)	;INCREMENT DESTINATION ADDRESS
	SOB	R3,5$			;LOOP
;	NOW GET THE COMMANDS
GETCMD:	MOV	#ICMD,R3		;POINT TO COMMAND BUFFER
CMDLOP:	CALL	INPUT			;GET A COMMAND
	SKIP	40			;SKIP ANY SPACES
	CMPB	#73,(R0)		;A COMMENT?
	BEQ	CMDLOP			;JUST IGNORE IF SO
	CMPB	#'E,(R0)		;END COMMAND?
	BNE	1$			;NO
	MOV	#-1,(R3)+		;SIGNAL THE END
	JMP	PATDO			;GO PROCESS PATCHES
1$:	CMPB	#'P,(R0)		;IS IT A "P"URGE COMMAND?
	BEQ	GETCMD			;YES, START OVER
	CMPB	#'7,(R0)		;GOT A NUMBER?
	BPL	.+6			;YES
	JMP	SYNTAX			;SYNTAX ERROR IF NOT
	ASCBIN	ARG			;G;CONVERT THE NUMBER
	CMPB	#'/,R2			;OLD CONTENT VERIFICATION?
	BNE	2$			;NO
	MOV	#-1,ARG2		;FLAG THE TYPE AS A ONE-TIMER
	SKIP	40			;SKIP SPACES
	ASCBIN	ARG3			;READ VERIFY VALUE
	MOV	ARG,R4			;GET ADDRESS
	SUB	LADR,R4			;SEE IF IN RANGE
	BPL	.+6			;YES
	JMP	OUTRGE			;NO, ERROR
	ADD	#INXARY+10000,R4	;DETERMINE BUFFER ADDRESS
	CMP	ARG3,(R4)		;DO THE CONTENTS MATCH?
	BEQ	.+6			;YES
	JMP	WRONG			;NO, ERROR
	CMPB	#':,R2			;DO WE HAVE A ":"?
	BEQ	.+6			;YES (WE BETTER)
	JMP	SYNTAX			;ERROR OTHERWISE
5$:	SKIP	40			;SKIP SPACES
	ASCBIN	ARG3			;READ IN NEW CONTENTS TO USE
	BR	4$			;CONT
2$:	CMPB	#':,R2			;SIMPLY A ":" FOR NEW CONTENTS?
	BNE	3$			;NO
	MOV	#-1,ARG2		;SIGNAL THE ONE-TIMER
	BR	5$			;GET NEW CONTENTS
3$:	CLR	ARG2			;SIGNAL MULTIPLE INPUTS
4$:	CALL	PATFRM			;FORM THE COMMAND BUFFER FROM INPUT
	CMP	#ICMDE-10,R3		;COMMAND BUFFER FULL?
	BPL	.+6			;NO
	JMP	OVRFLW			;YES, OVERFLOW
	JMP	CMDLOP			;LOOP TIL DONE
	.PAGE
;**************************************************************************
;
;	PROCESS COMMAND INPUT AND FORM THE COMMAND BUFFER FOR LATER
;
;**************************************************************************
PATFRM:	TST	ARG2			;IS IT A ONE TIMER?
	BEQ	LOOP			;NO, LOOP
	CALL	PATADR			;CHECK ADDRESS AND GET OLD VALUE
	MOV	R4,(R3)+		;SAVE ADDRESS
	MOV	ARG3,(R3)+		;AND NEW CONTENTS
	MOV	#PRPT1,R1		;MESSAGE FORMAT
	CALL	OUTPUT			;REPORT IT
	RETURN
LOOP:	CALL	PATADR			;CHECK ADDRESS AND GET OLD VALUE
	MOV	#OUT,R0			;BUFF PTR
	MOV	#PRPT2,R1		;MESSAGE FORMAT
	MOV	#ARG,R2			;ARG BLOCK
	CALL	$EDMSG			;FORMAT THE MESSAGE
	CLR	INP2			;INIT INPUT BUFF
	MOV	R1,PMSG+Q.IOPL+10	;SAVE LENGTH
	DIR$	#PMSG			;GET THE INPUT VALUE
	DSWERR
	TST	INP2			;GOT ANYTHING?
	BNE	.+4			;YES
	RETURN
	CMPB	#'/,INP2		;GOT A "/"?
	BEQ	2$			;YES, JUST SKIP
	CMPB	#'7,INP2		;GOT A VALUE?
	BPL	.+6			;YES
	JMP	SYNTAX			;NO, ERROR
	MOV	#INP2,R0		;PTR TO INPUT
	ASCBIN	ARG3			;GET NEW CONTENTS
	MOV	R4,(R3)+		;SAVE ADDRESS
	MOV	ARG3,(R3)+		;NEW CONTENTS
	CMPB	#'/,R2			;WAS THERE A "/" AT THE END?
	BEQ	2$			;YES
	RETURN
2$:	ADD	#2,ARG			;GO TO NEXT ADDRESS
	JMP	LOOP			;AND LOOP
;
;	CHECK ADDRESS REQUEST
;
PATADR:	MOV	ARG,R4			;GET THE ADDRESS
	CMP	LADR,R4			;IS IT HIGHER THAT THE LOAD ADDR.?
	BLE	.+6			;YES
	JMP	OUTRGE			;NO, OUT OF RANGE
	CMP	R5,R4			;ABOVE THE UPPER LIMIT?
	BPL	.+6			;NO
	JMP	OUTRGE			;NO, OUT OF RANGE
	SUB	LADR,R4			;GET OFFSET
	CMP	SIZE,R4			;ARE WE EXTENDING IT?
	BPL	.+6			;NO
	MOV	R4,SIZE			;IF YES, SAVE NEW SIZE
	ADD	#INXARY+10000,R4	;GET BUFFER ADDRESS
	MOV	(R4),ARG2		;GET OLD CONTENTS
	RETURN
	.PAGE
;**************************************************************************
;
;	PROCESS THE PATCH COMMANDS
;
;**************************************************************************
PATDO:	MOV	#ICMD,R2		;POINT TO THE COMMAND BUFFER
1$:	CMP	#-1,(R2)		;END OF COMMANDS?
	BNE	.+6			;NO
	JMP	PATDNE			;YES, DONE
	MOV	(R2)+,R4		;GET ADDRESS
	MOV	(R2)+,(R4)		;SAVE THE NEW CONTENTS
	BR	1$			;LOOP
;	WE ARE DONE, SO CLEAN UP AND COPY REST OF CIL
PATDNE:	MOV	ARG5,R2			;POINT TO INDEX ENTRY AGAIN
	MOV	SIZE,10(R2)		;SAVE THE NEW SIZE
	MOV	(R2),R3			;GET RECORD SIZE
	TST	-(R2)			;BACK UP OVER THE "1"
	CLR	CKSUM			;INIT
	ASR	R3			;WORD OFFSET
1$:	TST	(R2)+			;GO THROUGH THE RECORD
	CALL	CHECK			;CALC THE CHECKSUM
	SOB	R3,1$			;LOOP
	CKS	R2			;SAVE THE CHECKSUM
	MOV	INXSIZ,R2		;GET # OF BLOCKS IN INDEX
	ASH	#9.,R2			;MAKE IT BYTES
	MOV	#PRIBUF,F.BKDS+2+PRIINP ;RESET INPUT BUFFER AGAIN
	MOV	#INXARY,R1		;PTR TO INDEX
	CALL	CILDMP			;DUMP IT TO THE OUTPUT CIL
	MOV	CILBK1,R1		;GET # OF BLOCKS LEFT
	MOV	#OUTCIL,R0		;FDB
	MOV	#PRIBUF,F.BKDS+2(R0)	;WRITE FROM THAT INPUT BUFFER
2$:	CMP	BLOCK,F.BKVB+2(R0)	;ARE WE AT THE MODULE WE CHANGED?
	BEQ	3$			;YES
	MOV	#PRIINP,R0		;FDB
	CALL	READ			;READ A BLOCK
	MOV	#OUTCIL,R0		;FDB
	CALL	WRITE			;WRITE A BLOCK
	SOB	R1,2$			;LOOP
	JMP	RESTAR			;RESTART
3$:	MOV	#INXARY+10000,F.BKDS+2(R0) ;NOW WRITE OUT NEW CORE IMAGE
	MOV	SIZE,R5			;GET SIZE
	ADD	#777,R5			;ROUND UP
	ASH	#-9.,R5			;CALC # OF BLOCKS
4$:	CALL	WRITE			;WRITE IT OUT
	DEC	R1			;COUNT IT
	ADD	#BLKSIZ,F.BKDS+2(R0)	;INCREMENT BUFF PTR
	SOB	R5,4$			;LOOP
	MOV	#PRIBUF,F.BKDS+2(R0)	;REINIT
	JMP	2$			;GO BACK
	.PAGE
;**************************************************************************
;
;	LOCAL ERROR ROUTINES
;
;**************************************************************************
NOCERR:	MOV	#NOCER,R1		;MESSAGE FORMAT
	CALL	PRINT			;PRINT THE MESSAGE
	JMP	GETMOD			;CONTINUE
NOCER:	.WORD	NOCERL
	.ASCII	/CPA> *** "C" COMMAND EXPECTED ***/
NOCERL	=	.-NOCER-2		;LENGTH
	.EVEN
NOIERR:	MOV	#NOIER,R1		;MESSAGE FORMAT
	CALL	PRINT			;PRINT THE MESSAGE
	JMP	GETIDT			;CONTINUE
NOIER:	.WORD	NOIERL
	.ASCII	/CPA> *** "I" COMMAND EXPECTED ***/
NOIERL	=	.-NOIER-2		;LENGTH
	.EVEN
SHTERR:	MOV	#SHTER,R1		;MESSAGE FORMAT
	CALL	PRINT			;PRINT THE MESSAGE
	JMP	GETMOD			;CONTINUE
SHTER:	.WORD	SHTERL
	.ASCII	/CPA> *** UNEXPECTED END OF COMMAND INPUT ***/
SHTERL	=	.-SHTER-2		;LENGTH
	.EVEN
NOMTCH:	MOV	#NOMCH,R1		;MESSAGE FORMAT
	CALL	PRINT			;PRINT THE MESSAGE
	JMP	RESTAR			;CONTINUE
NOMCH:	.WORD	NOMCHL
	.ASCII	/CPA> *** MODULE REQUESTED NOT FOUND IN CIL ***/
NOMCHL	=	.-NOMCH-2		;LENGTH
	.EVEN
CONERR:	MOV	#CONMG,R1		;MESSAGE FORMAT
	CALL	PRINT			;PRINT THE MESSAGE
	JMP	RESTAR			;CONTINUE
CONMG:	.WORD	CONMGL
	.ASCII	/CPA> *** ERROR OPENING CONTIGUOUS CIL FILE ***/
CONMGL	=	.-CONMG-2		;LENGTH
	.EVEN
SYNTAX:	MOV	#SYNT,R1		;MESSAGE FORMAT
	CALL	PRINT			;PRINT THE MESSAGE
	JMP	CMDLOP			;CONTINUE
SYNT:	.WORD	SYNTL
	.ASCII	/CPA> *** ILLEGAL SYNTAX ***/
SYNTL	=	.-SYNT-2		;LENGTH
	.EVEN
	.PAGE
OUTRGE:	MOV	#OUTR,R1		;MESSAGE FORMAT
	CALL	PRINT			;PRINT THE MESSAGE
	JMP	CMDLOP			;CONTINUE
OUTR:	.WORD	OUTRL
	.ASCII	/CPA> *** ADDRESS OUT OF RANGE ***/
OUTRL	=	.-OUTR-2		;LENGTH
	.EVEN
OVRFLW:	MOV	#OVRF,R1		;MESSAGE FORMAT
	CALL	PRINT			;PRINT THE MESSAGE
	JMP	CMDLOP			;CONTINUE
OVRF:	.WORD	OVRFL
	.ASCII	/CPA> *** TOO MANY COMMANDS ***/
OVRFL	=	.-OVRF-2		;LENGTH
	.EVEN
WRONG:	MOV	#WRNG,R1		;MESSAGE FORMAT
	CALL	PRINT			;PRINT THE MESSAGE
	JMP	CMDLOP			;CONTINUE
WRNG:	.WORD	WRNGL
	.ASCII	/CPA> *** CONTENTS VERIFICATION FAILURE ***/
WRNGL	=	.-WRNG-2		;LENGTH
	.EVEN
PMSG:	QIOW$	IO.RPR,5,1,,,,<INP2,80.,,OUT,0,44>
PRPT1:	.ASCIZ	? %P/%P:%P?
PRPT2:	.ASCIZ	? %P/%P:?
	.EVEN
	.END