.TITLE	HG$SET_KEYSTATE
	.IDENT	"01-001"
;+
;  Function:	HG$SET_KEYSTATE
;
;  Author:	Hunter Goatley   15-MAY-1987
;		Academic Computing, STH 226
;		Western Kentucky University
;		Bowling Green, KY 42101
;		Voice:	502-745-5251
;		E-mail:	GOATHUNTER@WKUVX1.bitnet
;			GOATHUNTER%wkuvx1@wku.edu
;
;  Functional description:
;
;	HG$SET_KEYSTATE performs the same function as the DCL SET KEY/STATE=
;	command.
;
;  Inputs:
;
;	4(AP)	- Descriptor pointing to the new key state name
;	8(AP)	- Address of word to receive length of string returned
;		  (0 if not desired)
;	12(AP)	- Descriptor pointing to buffer to receive old key state
;		  (0 if not desired)
;
;  Outputs:
;
;	Status in R0	- SS$_NORMAL, codes returned by STR$COPY_R
;
;  Effects:
;
;	Sets and returns DCL Key State
;
;  Calling sequence:
;
;    STATUS = HG$SET_KEYSTATE ("SETDEF", LENGTH%, OLDSTATE$)
;-

	.LIBRARY	/DCL$KEYLIB:DCLKEY.MLB/
	.LINK		/SYS$SYSTEM:SYS.STB/
	.LINK		/SYS$SYSTEM:DCLDEF.STB/

	.PSECT	_HG$SET_KEYSTATE_CODE,EXE,NOWRT,PIC,SHR
NEWSTATE	= 4
OLDLEN		= 8
OLDSTATE	= 12
	.ENTRY	HG$SET_KEYSTATE,^M<>
	CHECK_ARGS	#3			; Were enough arguments given?
10$:	$CMEXEC_S -				; Need to be in EXEC mode
		ROUTIN=EXEC_SET_KEYSTATE, -	; ...
		ARGLST=(AP)			; ...
	RET					; Return to caller

	.ENTRY	EXEC_SET_KEYSTATE,^M<R2,R3,R4,R5,R6,R7,R11>
	GET_PRC					; Get the PRC adtress
	MOVL	PRC_L_CURRKEY(R11),R6		; Get address of key state
	TSTL	OLDSTATE(AP)			; Did user want old state name?
	BEQLU	10$				; No - skip it
	MOVZBL	(R6),R0				; Get the length of the state
	PUSHL	R0				; Push the length
	MOVL	SP,R0				; Get the address of the length
	PUSHL	R6				; Push the string address
	INCL	(SP)				; Bump it past the length
	PUSHAL	(R0)				; Push address of length
	PUSHL	OLDSTATE(AP)			; Push return desc. address
	CALLS	#3,G^STR$COPY_R			; Copy the string to the buffer
	POPL	R1				; Remove the old length
	BLBC	R0,100$				; Error?  Return if so
10$:	TSTL	OLDLEN(AP)			; Did user want return length?
	BEQLU	20$				; No - skip it
	MOVZBW	(R6),@OLDLEN(AP)		; Move the length
20$:	TSTL	NEWSTATE(AP)			; Did user give new state?
	BEQLU	90$				; No - skip it
; R6 --> current key state
	MOVQ	@NEWSTATE(AP),R4		; Get new state descriptor
	MOVZWL	R4,R1				; Move size to R1
	INCL	R1				; Bump to include count byte
	BSBB	ALLOSTATE			; Get some new memory
	MOVL	R2,PRC_L_CURRKEY(R11)		; Set new state address
	MOVB	R4,(R2)+			; Set the new state length
	MOVC3	R4,(R5),(R2)			; Set the new keypad state
	BSBB	DEALSTATE			; Deallocate the old state
	MOVL	PRC_L_CURRKEY(R11), -		; Copy the key state address
		PRC_L_LASTKEY(R11)		; ...  to PRC_L_LASTKEY
90$:	MOVL	#SS$_NORMAL,R0			; Set return status
100$:	RET

DEALSTATE:
	PUSHR	#^M<R0,R1,R3>		; Save work registers
	MOVAB	PRC_Q_ALLOCREG(R11),R3	; Get allocation region listhead
	MOVL	R6,R0			; Get address
	MOVZBL	(R0),R1			; Get deleted entry size
	INCL	R1			; Bump to include length byte
	ADDL2	#7,R1			; Truncate to a quadword boundary
	BICL2	#7,R1			; Round to next quadword boundary
	JSB	@#EXE$DEALLOCATE	; Deallocate the memory
	POPR	#^M<R0,R1,R3>		; Restore work registers
	RSB				; Return to caller

ALLOSTATE:
	PUSHR	#^M<R0,R1,R3>		; Save work registers
	MOVAB	PRC_Q_ALLOCREG(R11),R3	; Get allocation region listhead
	ADDL2	#7,R1			; Truncate to a quadword boundary
	BICL2	#7,R1			; Round to next quadword boundary
	JSB	@#EXE$ALLOCATE		; Deallocate the memory
	POPR	#^M<R0,R1,R3>		; Restore work registers
	RSB				; Return to caller

	.END