;===============   DCLKEYMACS.MAR
;
; AUTHOR:	Hunter Goatley
;		Clyde Digital Systems
;		371 East 800 South
;		Orem, Utah  84058
;		(801) 224-5306
;		CREATION DATE:	15-MAY-1987

;
;  CHECK_ARGS	- Checks the number of arguments passed to a routine.
;		  If an invalid number of arguments are given, control
;		  returns to the user with LIB$_WRONUMARG status.
;
	.MACRO	CHECK_ARGS	NUMBER,?LABEL
	MOVL	#LIB$_WRONUMARG,R0	; Assume error
	CMPW	NUMBER,(AP)		; Were there enough?
	BEQLU	LABEL			; Yes - no sweat
	RET				; No - return with error
LABEL:	.ENDM	CHECK_ARGS

;
;  GET_PRC	- Places the PRC address in R11.
;
	.MACRO	GET_PRC
	MOVAL	G^CTL$AG_CLIDATA,R11	; Get address of CLI data
	MOVL	PPD$L_PRC(R11),R11	; Get address of PRoCess data region
	.ENDM	GET_PRC


;================  DEFINE.MAR
	.TITLE	HG$DEFINE_KEY
	.IDENT	"01-001"
;+
;  Function:	HG$DEFINE_KEY
;
;  Author:	Hunter Goatley   15-MAY-1987
;
;  Functional description:
;
;	HG$DEFINE_KEY performs the same function as the DCL DEFINE/KEY command.
;
;  Inputs:
;
;	4(AP)	- Descriptor pointing to the keyname to define
;	8(AP)	- Descriptor pointing to the key's value
;	12(AP)	- Descriptor pointing to /IF_STATE= string
;	16(AP)	- Descriptor pointing to /SET_STATE string (0
;	   	  if the key does not SET_STATE)
;	20(AP)	- Address of longword holding SYM_M_* flags
;
;  Outputs:
;
;	Status in R0	- SS$_NORMAL, LIB$_INSCLIMEM
;
;  Effects:
;
;	Defines a DCL key
;
;  Calling sequence:
;
;    STATUS = HG$DEFINE_KEY ("PF1","SHOW USERS","DEFAULT",,(SYM_M_ECHO) BY REF)
;-
VMS4_5 = 1	;**************************** Remove this line if under VMS 4.1

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

	.PSECT	_HG$DEFINE_KEY_CODE,EXE,NOWRT,LONG,PIC,SHR
KEY_NAME	= 4
EQUIVALENCE	= 8
IF_STATE	= 12
SET_STATE	= 16
FLAGS		= 20
WORK_BYTES	= 512
	.ENTRY	HG$DEFINE_KEY,^M<R3,R10,R11>
	CHECK_ARGS	#5		; Make sure 5 arguments are present
	SUBL2	#WORK_BYTES,SP		; Allocate some space on the stack
	MOVL	SP,R10			; R10 --> template
;
;  Fill in the key template
;
	CLRL	SYM_L_FL(R10)		; Clear forward link
	CLRL	SYM_L_BL(R10)		; Clear backward link

.IF DEFINED VMS4_5
	CLRL	SYM_L_ORDERED(R10)	; Clear ORDERED link (not used)
	CLRW	SYM_W_FILELEVEL(R10)	; Clear file level
	MNEGW	#1,SYM_W_PROCLEVEL(R10)	; Set no procedure level
	CLRL	SYM_L_PROCSEQ(R10)	; ...
	CLRW	SYM_W_BLOCKLEVEL(R10)	; ...
	CLRL	SYM_L_BLOCKSEQ(R10)	; ...
.ENDC
	CLRW	SYM_W_SIZE(R10)		; Clear size
	MOVB	#SYM_K_KEYPAD, -	; Set symbol entry type (KEYPAD symbol)
		SYM_B_TYPE(R10)		; ...
	MOVL	FLAGS(AP),R0		; Get the flags
.IF DEFINED VMS4_5
	MOVW	(R0),SYM_W_FLAGS(R10)	; ...  and set them in the template
.IF_FALSE
	MOVB	(R0),SYM_B_FLAGS(R10)	; ...  and set them in the template
.ENDC
	MOVAB	SYM_T_SYMBOL(R10),R3	; Get address in template of key name
	MOVL	KEY_NAME(AP),R0		; Get the key name
	MOVB	(R0),(R3)+		; Move its length
	MOVC3	(R0),@4(R0),(R3)	; Copy the string to the template
	MOVW	@IF_STATE(AP),R0	; Get sum of lengths of next 3 strings
	ADDW2	@EQUIVALENCE(AP),R0	; ...
	TSTL	SET_STATE(AP)		; Was a SET_STATE name given?
	BEQLU	10$			; No - don't try to move the length
	ADDW2	@SET_STATE(AP),R0	; ...
10$:	ADDW2	#4,R0			; ...  + 4 (the number of length bytes)
	MOVW	R0,(R3)+		; Put sum of lengths of next 3 fields
	PUSHL	R0			; Save the length for a minute
	MOVL	IF_STATE(AP),R1		; Get address of IF_STATE
	MOVB	(R1),(R3)+		; Move length of IF_STATE
	MOVC3	(R1),@4(R1),(R3)	; Move IF_STATE string
	MOVL	EQUIVALENCE(AP),R1	; Get address of EQUIVALENCE string
	MOVW	(R1),(R3)+		; Move length of EQUIVALENCE
	MOVC3	(R1),@4(R1),(R3)	; Move EQUIVALENCE string
	MOVL	SET_STATE(AP),R1	; Get address of SET_STATE
	BEQLU	20$			; If the address is 0, no SET_STATE
	MOVB	(R1),(R3)+		; Move length of SET_STATE
	MOVC3	(R1),@4(R1),(R3)	; Move SET_STATE string
.IF DEFINED VMS4_5
	BISW2	#SYM_M_STATE, -		; Set STATE bit in FLAGS (just in case
		SYM_W_FLAGS(R10)	; ...  the caller did not set it)
.IF_FALSE
	BISB2	#SYM_M_STATE, -		; Set STATE bit in FLAGS (just in case
		SYM_B_FLAGS(R10)	; ...  the caller did not set it)
.ENDC
20$:	CLRB	(R3)+			; Clear last byte of template (could be
					; ...  taken as length of SET_STATE)
	ADDL3	(SP)+,#SYM_T_SYMBOL+1,R0 ; Calculate the size of the template
	ADDB2	SYM_T_SYMBOL(R10),R0	; ...
	ADDL2	#2,R0			; Include word sum of the 3 lengths
	ADDL2	#7,R0			; Truncate to a quadword boundary
	BICL2	#7,R0			; Round to next quadword boundary
	MOVW	R0,SYM_W_SIZE(R10)	; Set the size of the queue entry
	$CMEXEC_S -			; Go to executive mode to define key
		ROUTIN=EXEC_KEYDEF	; ...
	ADDL2	#WORK_BYTES,SP		; Clean up the stack
	RET
;
;  Executive mode routine to allocate CLI memory and insert the new key
;  definition into the KEYPAD queue.
;
	.ENTRY	EXEC_KEYDEF,^M<R3,R11>
	GET_PRC					; Get address or PRoCess data
	MOVAB	PRC_Q_ALLOCREG(R11),R3		; Addr of free memory
	MOVZWL	SYM_W_SIZE(R10),R1		; Get size of block to allocate
	JSB	@#EXE$ALLOCATE			; Allocate some CLI memory
	MOVL	#LIB$_INSCLIMEM,R0		; Assume not enough CLI memory
	TSTL	R2				; Was there space allocated?
	BEQL	20$				; No - return the error
	PUSHR	#^M<R0,R1,R2,R3,R4,R5>		; Copy the key definition from
	MOVC5	SYM_W_SIZE(R10),(R10),#0, -	; ...  the template on the
		R1,(R2)				; ...  stack to the memory just
	POPR	#^M<R0,R1,R2,R3,R4,R5>		; ...  allocated
	MOVW	R1,SYM_W_SIZE(R10)		; Set actual length allocated
	BSBW	FIND_PLACE			; Find the queue position for
						; ...  the key definition
	INSQUE	SYM_L_FL(R2),@SYM_L_BL(R0)	; Insert key def into queue at
						; ...  position returned in R0
						; ...  (by FIND_PLACE)
	MOVL	#SS$_NORMAL,R0			; Set successful return status
20$:	RET					; Return to caller

;+
;  For efficiency and special-processing, internal subroutines were used
;  to find the queue position and delete an existing key definition (instead
;  of using the CALLable routines HG$FIND_KEY and HG$DELETE_KEY).
;-
FIND_PLACE:
	PUSHR	#^M<R1,R2,R3,R4,R5,R6,R7,R8,R9>	; Save registers needed
	MOVAB	SYM_T_SYMBOL+1(R10),R1		; Get addr of key name
	MOVZBL	-1(R1),R0			; Get its length
	ADDL2	R0,R1				; R1 --> word length of rest
	INCL	R1				; Bump R1 over the word length
 	INCL	R1				; R1 --> IF_STATE string
	MOVZBL	(R1)+,R0			; Get the IF_STATE length
	PUSHL	R1				; Put addr on the stack
	PUSHL	R0				; Put the length on the stack
	MOVZBL	SYM_T_SYMBOL(R10),R8		; R8 = length of key name
	MOVAB	SYM_T_SYMBOL+1(R10),R9		; R9 --> key name
	MOVL	PRC_Q_KEYPAD(R11),R6		; R6 --> first entry in queue
	MOVAB	PRC_Q_KEYPAD(R11),R7		; R7 --> beginning of queue
10$:	CMPL	R6,R7				; Reached end of queue?
	BEQLU	20$				; Yes - found place
						; Check the state name
	MOVAB	SYM_T_SYMBOL+1(R6),R1		; Get addr of key name
	MOVZBL	-1(R1),R0			; Get its length
	ADDL2	R0,R1				; R1 --> word length of rest
	INCL	R1				; Bump R1 over the word length
	INCL	R1				; R1 --> IF_STATE string
	MOVZBL	(R1)+,R0			; Get the IF_STATE length
	CMPC5	(SP),@4(SP),#^A/ /,R0,(R1)	; Is this the same state?
	BLSSU	20$				; No - try next entry
 	BGTRU	15$				; If >, no entries for IF_STATE
						; Check the key names
	MOVZBL	SYM_T_SYMBOL(R6),R0		; Get length of key name in que
	CMPC5	R8,(R9),#^A/ /,R0,SYM_T_SYMBOL+1(R6)	; Compare the strings
	BLSSU	20$				; Found place if KEY < QUEUE KEY
	BNEQU	15$				; If not the same, go try next
;
; Here if key already exists
;
	BSBW	DELETEKEY			; Delete the key
	BRB	20$				; Return to caller
15$:	MOVL	SYM_L_FL(R6),R6			; Get the next keypad entry
	BRB	10$				; ...  and try again
20$:	ADDL2	#8,SP	     			; Clean up stack
	MOVL	R6,R0				; Return addr of QUEUE KEY entry
	POPR	#^M<R1,R2,R3,R4,R5,R6,R7,R8,R9>	; ...
	RSB					; ...

DELETEKEY:
	PUSHL	R3				; Save work register
	MOVAB	PRC_Q_ALLOCREG(R11),R3		; Get allocation region listhead
	REMQUE	SYM_L_FL(R6),R0			; Remove key def from the queue
	MOVL	SYM_L_FL(R0),R6			; Make the Forward Link entry
						; ... new "current" entry
	MOVZWL	SYM_W_SIZE(R0),R1		; Get deleted entry size
	JSB	@#EXE$DEALLOCATE		; Deallocate the memory
	MOVL	(SP)+,R3			; Restore register
	RSB					; Return to caller

	.END

;================  DELETE.MAR
	.TITLE	HG$DELETE_KEY
	.IDENT	"01-001"
;+
;  Function:	HG$DELETE_KEY
;
;  Author:	Hunter Goatley   15-MAY-1987
;
;  Functional description:
;
;	HG$DELETE_KEY performs the same function as the DCL DELETE/KEY command.
;
;  Inputs:
;
;	4(AP)	- Descriptor pointing to the keyname to delete
;	8(AP)	- Descriptor pointing to /STATE string
;
;  Outputs:
;
;	Status in R0	- SS$_NORMAL, LIB$_NOTFOU
;
;  Effects:
;
;	Deletes DCL key definition
;
;  Calling sequence:
;
;    STATUS = HG$DELETE_KEY ("PF1","DEFAULT")
;-

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

	.PSECT	_HG$DELETE_KEY_CODE,EXE,NOWRT,PIC,SHR
KEY	= 4
STATE	= 8
	.ENTRY	HG$DELETE_KEY,^M<>
	CHECK_ARGS	#2			; Check # of arguments
	$CMEXEC_S -				; Need to be in EXEC mode
		ROUTIN=EXEC_DELETE_KEY, -	; ...
		ARGLST=(AP)			; ...
	RET					; Return to caller

	.ENTRY	EXEC_DELETE_KEY,^M<R2,R3,R6>
	GET_PRC					; Get the PRC address
	MOVAL	-(SP),R6			; Get some stack space
	PUSHAL	(R6)				; Longword to receive address
	PUSHL	STATE(AP)			; Push state descriptor address
	PUSHL	KEY(AP)				; Push key descriptor address
	CALLS	#3,G^HG$FIND_KEY	       	; Find the key's queue address
	BLBC	R0,100$			    	; Error?  Exit with error
;
;  Here if (R6) has valid keypad entry address
;
	MOVL	(R6),R6				; Get address of entry
	REMQUE	SYM_L_FL(R6),R0			; Remove the keypad entry from
						; ...  the keypad queue
	MOVZWL	SYM_W_SIZE(R0),R1		; Get the size of the block
	MOVAB	PRC_Q_ALLOCREG(R11),R3		; Get allocation region listhead
	JSB	@#EXE$DEALLOCATE		; Deallocate the block
	MOVL	#SS$_NORMAL,R0			; Set successful return status
100$:	TSTL	(SP)+				; Reset stack pointer
	RET					; Return to caller

	.END

;================  FIND.MAR
	.TITLE	HG$FIND_KEY
	.IDENT	"01-001"
;+
;  Function:	HG$FIND_KEY
;
;  Author:	Hunter Goatley   15-MAY-1987
;
;  Functional description:
;
;	HG$FIND_KEY returns the address of a key definition if it exists.
;	If there is no matching definition, the address of the predecessor
;	is returned.
;
;  Environment:
;
;	EXECutive mode
;
;  Inputs:
;
;	4(AP)	- Descriptor pointing to the keyname to define
;	8(AP)	- Descriptor pointing to /IF_STATE= string
;
;  Returns:
;
;	R0 = SS$_NORMAL if key was found (Address in 12(AP))
;	R0 = LIB$_NOTFOU if key was not found (Predecessor address in 12(AP))
;
;  Effects:
;
;	None.
;
;  Calling sequence:
;
;    STATUS = HG$FIND_KEY ("PF1","DEFAULT", ADDRESS%)
;-

	.LIBRARY	/DCL$KEYLIB:DCLKEY.MLB/

	$SSDEF
	$LIBDEF

	.PSECT	HG$FIND_KEY,EXE,NOWRT,SHR,PIC
KEY	= 4
IF_STATE = 8
ADDR	= 12
	.ENTRY	HG$FIND_KEY,^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
	CHECK_ARGS	#3
	GET_PRC					; Get the PRC address
	MOVQ	@KEY(AP),R8			; Get key name descriptor
	MOVQ	@IF_STATE(AP),-(SP)		; Get IF_STATE descriptor
	MOVL	ADDR(AP),R10			; Longword to return addr in
	MOVL	PRC_Q_KEYPAD(R11),R6		; Get keypad queue listhead
	MOVAB	PRC_Q_KEYPAD(R11),R7		; Get address of queue listhead
;
;  Loop through all keypad entries until the correct entry is found.
;
10$:	MOVL	R6,(R10)			; Move PREDECESSOR address
	CMPL	R6,R7				; Have we reached the end?
	BEQLU	100$				; ... (Current entry = listhead)
	MOVAB	SYM_T_SYMBOL(R6),R1		; Addr of entry's KEY name
	MOVZBL	(R1)+,R0			; Get length of KEY name
	ADDL2	R0,R1				; R1 --> word length of rest
	TSTW	(R1)+				; Bump over the word length
	MOVZBL	(R1)+,R0			; R0 = length of IF_STATE name
						; R1 -> IF_STATE name
	CMPC5	(SP),@4(SP),#^A/ /,R0,(R1)	; Is the state = given state?
	BLSSU	100$				; If <, no entries for given state
	BGTRU	20$				; If >, go check next keypad entry
;
;  Here if we have a match on the IF_STATE
;
	MOVZBL	SYM_T_SYMBOL(R6),R0		; R0 = len of entry's KEY name
	CMPC5	R8,(R9),#^A/ /,R0,SYM_T_SYMBOL+1(R6)	; Right entry?
	BLSSU	100$				; If <, found predecessor
	BNEQU	20$				; If <>, try next entry
;
;  Here if we found the target keypad entry
;
	MOVL	#SS$_NORMAL,R0			; Set return status
	BRB	110$				; ... and go return to caller
20$:	MOVL	SYM_L_FL(R6),R6			; Get addr of next keypad entry
	BRB	10$				; ... and check it out
100$:	MOVL	#LIB$_NOTFOU,R0			; Return "Not found" status
110$:	ADDL2	#8,SP				; Reset stack pointer
	RET					; Return to caller

	.END


;================  GETDEF.MAR
	.TITLE	HG$GET_KEYDEF
	.IDENT	"01-001"
;+
;  Function:	HG$GET_KEYDEF
;
;  Author:	Hunter Goatley   15-MAY-1987
;
;  Functional description:
;
;	HG$GET_KEYDEF returns the definition of a DCL key.
;
;  Inputs:
;
;	4(AP)	- Descriptor pointing to the keyname to return info about
;	8(AP)	- Descriptor pointing to the state name
;	12(AP)	- Descriptor pointing to buffer to receive equivalence string
;	16(AP)	- Address of a word to receive the definition flags
;	20(AP)	- Descriptor pointing to buffer to receive /SET_STATE string (0
;	   	  if the key does not SET_STATE)
;
;  Outputs:
;
;	Status in R0	- SS$_NORMAL, LIB$_NOTFOU
;
;  Calling sequence:
;
;    STATUS = HG$GET_KEYDEF ("PF1","DEFAULT",EQUIV$, FLAGS%, SETSTATE$)
;-
VMS4_5 = 1	;**************************** Remove this line if under VMS 4.1

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

	.PSECT	_HG$GET_KEYDEF_CODE,EXE,NOWRT,PIC,SHR
KEY	= 4
STATE	= 8
EQUIV	= 12
FLAGS	= 16
SET_STATE = 20
	.ENTRY	HG$GET_KEYDEF,^M<>
	CHECK_ARGS	#5			; Check # of arguments
	$CMEXEC_S -				; Need to be in EXEC mode
		ROUTIN=EXEC_GET_KEYDEF, -	; ...
		ARGLST=(AP)			; ...
	RET

	.ENTRY	EXEC_GET_KEYDEF,^M<R6>
	GET_PRC					; Get the PRC address
	MOVAL	-(SP),R6			; Get some stack space
	PUSHAL	(R6)				; Longword to receive address
	PUSHL	STATE(AP)			; Push state descriptor address
	PUSHL	KEY(AP)				; Push key descriptor address
	CALLS	#3,G^HG$FIND_KEY		; Find the key's queue address
	BLBC	R0,100$				; Error?  Exit with error
;
;  Here if (R6) has valid keypad entry address
;
	MOVL	(R6),R6				; Get address of entry
.IF DEFINED VMS4_5
	MOVW	SYM_W_FLAGS(R6),@FLAGS(AP)	; Copy flags to user's buffer
.IF_FALSE
	MOVZBW	SYM_B_FLAGS(R6),@FLAGS(AP)	; Copy flags to user's buffer
.ENDC
	MOVAB	SYM_T_SYMBOL(R6),R6		; R6 -> symbol name
	MOVZBL	(R6)+,R0			; Get length of key name
	ADDL2	R0,R6				; Bump R6 over key name
	TSTW	(R6)+				; Bump R6 over word length
	MOVZBL	(R6)+,R0			; R0 = length of IF_STATE name
	ADDL2	R0,R6				; R6 -> ASCIC equivalence string
	MOVZWL	(R6)+,R0			; R0 = length of equiv. str.
				      		; R6 -> equivalence string
	PUSHL	R0				; ...  onto the stack
	MOVL	SP,R0				; ...  and get their address
	PUSHL	R6				; Push the length and address
	PUSHAL	(R0)				; ...  buffer
	PUSHL	EQUIV(AP)			; ...
	CALLS	#3,G^STR$COPY_R			; ...
	ADDL2	(SP)+,R6			; R6 --> ASCIC SET_STATE string
	MOVZBL	(R6)+,-(SP)			; SP --> length
	MOVL	SP,R0				; Get address of length
	PUSHL	R6				; Push the length and address
	PUSHAL	(R0)				; ...  buffer
	PUSHL	SET_STATE(AP)			; ...
	CALLS	#3,G^STR$COPY_R			; ...
100$:	RET					; Return to caller

	.END


;================  STATE.MAR
	.TITLE	HG$SET_KEYSTATE
	.IDENT	"01-001"
;+
;  Function:	HG$SET_KEYSTATE
;
;  Author:	Hunter Goatley   15-MAY-1987
;
;  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