.TITLE	CORZAP - ZAP CORE (SCOM) ROUTINE
	.IDENT	/V01/
	.MCALL	GMCR$,EXIT$S,QIOW$,DIR$
	.NLIST	BEX
;+
; VERSION 01
;
; REID L BROWN	25-JAN-77
;
; MODIFIED BY:
;
;	F. BORGER TO BECOME ABSZAP
;
;
; **-ABSZAP- ZAP CORE LOCATION WITH VALUE
;
; THIS ROUTINE OPERATES MUCH LIKE THE OPEN COMMAND, BUT IS INVOKABLE AS A ONE
; LINE COMMAND.  THIS ALLOWS ITS USE IN INDIRECT COMMAND FILES AND ANYWHERE
; ELSE A ONE LINE COMMAND IS DESIRED.  IT IS A PRIVILEDGED FUNCTION, AND CAN
; ONLY BE RUN FROM PRIVILEDGED TERMINALS.
;
; THE COMMAND FORMAT IS:
;
;	AZP <ADDRESS>[:<VERIFICATION>]/<NEWVALUE>
;
;	<ADDRESS>=	THE 22BIT ADDRESS OF THE WORD
;	<VERIFICATION>=	A VERIFICATION VALUE FOR THE CURRENT CONTENTS OF THAT
;			MEMORY CELL.  THE OPERATION IS ABORTED IF THIS VALUE
;			DOES NOT MATCH THE CURRENT CONTENTS OF THE CELL.
;	<NEWVALUE>=	THE NEW DATA VALUE TO BE PLACED IN THE CELL.
;
;	NOTE:	ALL VALUES ARE EXPRESSED AS UNSIGNED OCTAL NUMBERS
;
;
; TASKBUILD ATTRIBUTES:	-CP/-FX/PR/-FP
;			STACK=32
;			TASK=...AZP
;			ASG=TI:1	;ONE LUN ONLY
;			UNITS=1		; "
;			PRI=220
;			UIC=[1,1]
;
;-

 
 
;
; LOCAL DATA AREA
;
 
$ADDR:	.WORD	0,0		;THE ADDRESS OF THE CELL TO BE MODIFIED
$VFY:	.WORD	0		;AN OPTIONAL VERIFICATION VALUE
$VFLG:	.WORD	0		;IF <> 0, VERIFICATION IS DESIRED
$VAL:	.WORD	0		;THE NEW VALUE TO BE PLACED IN THE CELL
 
MCR:	GMCR$			;DEFINE THE GET MCR COMMAND LINE DIRECTIVE
 
OUT:	QIOW$	IO.WVB,1,1,,,,<.-.,.-.,40>	;DEFINE THE QIO DPB
OUTBUF=	OUT+Q.IOPL		;QIO BUFFER ADDRESS PARAMETER
OUTLEN=	OUT+Q.IOPL+2		;QIO BUFFER LENGTH PARAMETER
 
;
; ERROR MESSAGES
;
 
SYNTAX:	.ASCII	/AZP - SYNTAX ERROR/
	SYNLEN=	.-SYNTAX
 
 
VERIFY:	.ASCII	/AZP - VERIFICATION ERROR/
	VERLEN=	.-VERIFY
 
 
ADDRES:	.ASCII	/AZP - ADDRESS RANGE ERROR/
	ADDLEN=	.-ADDRES
 
 
 
PRVMES:	.ASCII	/AZP - PRIVILEDGE VIOLATION/
	PRVLEN=	.-PRVMES
 
	.EVEN

; **-CORZAP-
;
; GET COMMAND LINE AND CHECK FOR SYNTAX ERRORS
;
 
CORZAP::DIR$	#MCR,EXIT	;TRY TO GET AN MCR BUFFER, EXIT IF CAN'T
	MOV	$DSW,R5		;SAVE THE RETURNED LENGTH IN R5
	CALL	PRIVCK		;IS THE CALLER PRIVILEDGED FOR THIS?
	BCC	10$		;YES, CONTINUE
 
;
; PRIVILEDGE VIOLATION - EXIT
;
 
	MOV	#PRVMES,OUTBUF	;SET UP THE QIO
	MOV	#PRVLEN,OUTLEN	;...
	DIR$	#OUT		;AND TELL HIM ABOUT IT
	JMP	EXIT		;AND EXIT
 
 
;
; SCAN FOR OCTAL NUMBERS & SEPARATORS.
;
; $ADDR	<= THE ADDRESS VALUE
; $VFY	<= THE VERIFICATION VALUE
; $VFLG	<= <>0 IF VERIFICATION DESIRED (FLAG)
; $VAL	<= THE NEW VALUE
;
 
10$:	MOV	#MCR+6,R2	;POINT TO 1ST CHAR AFTER 'AZP' IN BUFFER
	ADD	#MCR+2,R5	;POINT TO END OF RETURNED DATA
	MOV	R5,-(SP)	;SAVE IT
	CLR	MCR+80.		;INSURE AGAINST A BUFFER OVERRUN.
	CLR	$VFLG		;RESET THE VERIFY FLAG
12$:	CMPB	(R2)+,#'/	;FIND END OF ADDRESS STRING
	BEQ	15$
	CMPB	-1(R2),#':	;COULD BE VERIFY ALSO
	BEQ	15$
	TSTB	(R2)		;END OF COMMAND ?
	BEQ	SYNERR		;IF SO, SYNTAX ERROR
	BR	12$		;IF NOT, KEEP LOOKING FOR / OR :
15$:	DEC	R2		;BACK UP R2 TO / OR :
	MOV	R2,R4		;CALC LENGTH OF ADDRESS STRING
	SUB	#MCR+6,R4	;FOR SYSTEM CALL
	MOV 	#MCR+6,R5	;POINT R5 TO START OF STRING
	MOV	#$ADDR,R3	;POINT R3 TO OUTPUT CONVERSION AREA
	CALL	.OD2CT		;CONVERT TO DOUBLE PRECISION OCTAL
	BIC	#1,$ADDR+2	;MAKE SURE WORD BOUNDARY
	MOV	(SP)+,R5	;RESTORE END OF DATA FLAG
	CMP	R2,R5		;HAVE WE OVERRUN THE END OF THE DATA
	BHIS	SYNERR		;YES - TELL THE USER
	MOV	R2,R0		;RESTORE POINTER FOR COTB CALLS
	INC	R0		;BUMP PAST TERMINATOR
	CMPB	#'/,(R2)	;DID THE FIELD TERMINATE WITH A SLASH ?
	BEQ	40$		;YES - GO PROCESS THE VALUE FIELD
	CMPB	#':,(R2)	;NO - IS VERIFICATION SUPPORTED?
	BNE	SYNERR		;NO - ??? CRAZY USER. SYNTAX ERROR

;
; GET VERIFICATION VALUE & SET VERIFY FLAG
;
 
	CALL	$COTB		;CONVERT THE VERIFY VALUE TO BINARY
	CMP	R0,R5		;HAVE WE OVERRUN THE RETURNED DATA?
	BHIS	SYNERR		;SYNTAX ERROR
 
	CMPB	#'/,R2		;TERMINATOR MUST BE A SLASH
	BNE	SYNERR		;SYNTAX ERROR
	INC	$VFLG		;INDICATE VERIFY IS TO BE DONE
	MOV	R1,$VFY		;SAVE THE VALUE
 
;
; EVALUATE THE REPLACEMENT VALUE
;
 
40$:	CALL	$COTB		;CONVERT THE VALUE TO BINARY
	MOV	R1,$VAL		;SAVE THE VALUE
 
;
; VALIDATE THE ADDRESS, VERIFY OLD CONTENTS (IF SPECIFIED) AND UPDATE
; THE LOCATION TO ITS NEW VALUE
;
	MOV	$ADDR+2,R1	;LOW ORDER ADDRESS -> R1
	MOV	$ADDR,R0	;HIGH ORDER ADDRESS -> R0
	ASHC	#3,R0		;SHIFT PAR PART OF ADDRESS TO R1
	ASH	#-3,R1		;RESET LOWER 13 BITS OF ADDRESS
	BIC	#160000,R1	;CLEAR BITS CARRIED FROM BIT 15
	ASH	#7,R0		;PUT UPPER ADDRESS IN RIGHT BITS
	BIS	#60000,R1	;MAP R1 TO USE PAR/PDR 3
	MOV	#77406,-(SP)	;A 4K READ/WRITE PDR -> STACK
	MOV	R0,-(SP)	;NEW PAR -> STACK
	CALL	..SPD3		;SWAP PAR/PDR 3
 
	TST	$VFLG		;VERIFY DESIRED?
	BEQ	60$		;NO - CONTINUE
	CMP	$VFY,@R1	;COMPARE TO EXISTING DATA
	BEQ	60$		;IT CHECKS, CONTINUE
	MOV	#VERIFY,OUTBUF	;DOESN'T CHECK - LOAD BUFFER ADR
	MOV	#VERLEN,OUTLEN	; AND LENGTH
	DIR$	#OUT		;TELL THE USER HE BLEW IT
	BR	EXIT		;AND EXIT
 
60$:	MOV	$VAL,@R1	;UPDATE THE DATA ITEM
 
EXIT:	EXIT$S			;AND EXIT

;
; SYNTAX ERROR
;
 
SYNERR:	MOV	#SYNTAX,OUTBUF	;LOAD MESSAGE ADDR
	MOV	#SYNLEN,OUTLEN	;AND ITS LENGTH
	DIR$	#OUT		;TELL THE USER
	BR	EXIT		;AND EXIT
 
 
;
; **-PRIVCK-CHECK USERS PRIVILEDGE BASED ON THE PUD BITS
;
;	RETURNS: CC-CLEAR IF PRIVILEDGED
;		 CC-SET IF NOT PRIVILEDGED
;	MODIFIES R0.
;
 
 
PRIVCK:	CLC			;RESET THE CARRY FLAG BIT
	MOV	.CRTSK,R0	;GET MY ATL ADDRESS
	MOV	A.TI(R0),R0	;AND USE IT TO GET MY PUD ADDRESS
	BITB	#UT.PR,U.TF(R0)	;IS MY TI  PRIVILEDGE BIT SET?
	BNE	10$		;YES - OK
	SEC			;NO - ERROR
10$:	RETURN
 
;
 	.END	CORZAP