From:	ADVAX::"mcnc!CUNYVM.CUNY.EDU!VMSSERV%WKUVX1.BITNET" 25-FEB-1991 13:08:21.99
To:	arisia::everhart
CC:	
Subj:	DISK$WKUPUB2:[VMSSERV.FILES.DCLKEYS]DCLKEYS.03_OF_03;1

Received: by ADVAX.DECnet (utk-mail11 v1.5) ; Mon, 25 Feb 91 13:07:15 EST
Received:  from mcnc by ge-dab.GE.COM (5.61/GE-DAB 1.15) with UUCP
	id AA03634 for ; Mon, 25 Feb 91 12:04:19 -0500
Received: from CUNYVM.CUNY.EDU by mcnc.mcnc.org (5.59/MCNC/6-11-90)
	id AA08815; Mon, 25 Feb 91 09:59:40 -0500
	for arisia.dnet.ge.com!everhart
Message-Id: <9102251459.AA08815@mcnc.mcnc.org>
Received: from WKUVX1.BITNET by CUNYVM.CUNY.EDU (IBM VM SMTP R1.2.2MX) with BSMTP id 6833; Mon, 25 Feb 91 10:00:05 EST
Date: Mon, 25 Feb 91 08:59 CST
From: mcnc!CUNYVM.CUNY.EDU!VMSSERV%WKUVX1.BITNET
Subject: DISK$WKUPUB2:[VMSSERV.FILES.DCLKEYS]DCLKEYS.03_OF_03;1
To: arisia::everhart
X-Vms-To: IN%"everhart@arisia.dnet.ge.com"
 
-+-+-+-+-+-+-+-+ START OF PART 3 -+-+-+-+-+-+-+-+
X`09MOVAB`09SYMBOLS,R8`09`09; Get the beginning of the first symbol
X`09MOVAL`09SYM_TABLE,R9`09`09; Move the address of the table-id to R9
X20$:`09TSTB`09(R8)`09`09`09; Are we finished (0 length)?
X`09BEQLU`09DO_KEYS`09`09`09; Yes -- leave
X`09BUILD_DESCS`09`09`09; Set up the string descriptors
X`09PUSHL`09R9`09`09`09; Push the address of table-id (global)
X`09PUSHL`09R6`09`09`09; Push addr of the equiv descriptor
X`09PUSHL`09R7`09`09`09; Push addr of the logical descriptor
X`09CALLS`09#3,G`5ELIB$SET_SYMBOL`09; Go define it
X`09BRB`0920$`09`09`09; Loop until done
X;  Define all keys for the process
XDO_KEYS:
X`09MOVAB`09KEYS_TABLE,R8`09`09; Get the beginning of the first symbol
X`09MOVAQ`09EQUIV_DESC,R6`09`09; Get address of equivalence descriptor
X`09MOVAQ`09SYM_LOG_DESC,R7`09`09; Get address of LOGICAL descriptor
X30$:`09TSTL`09(R8)`09`09`09; Are we finished (0 length)?
X`09BEQLU`09DO_REST`09`09`09; Yes -- leave
X`09MOVZBL`09(R8)+,R0`09`09; Get offset in vector table
X`09PUSHAL`09FLAGS_TABLE`5BR0`5D`09`09; ...
X`09MOVZBL`09(R8)+,R0`09`09; Get offset in vector table
X`09PUSHL`09STATE_TABLE`5BR0`5D`09`09; ...
X`09MOVZBL`09(R8)+,R0`09`09; Get offset in vector table
X`09PUSHL`09STATE_TABLE`5BR0`5D`09`09; ...
X`09BUILD_DESCS`09`09`09; Build the string descriptors
X`09PUSHL`09R6`09`09`09; Push addr of the equiv descriptor
X`09PUSHL`09R7`09`09`09; Push addr of the logical descriptor
X`09CALLS`09#5,HG$DEFINE_KEY`09; Go define it
X`09BRB`0930$`09`09`09; Loop until finished
X`09`09`09`09`09;
XDO_REST:`09`09`09`09;
X`09$SETPRN_S -`09`09`09; Set the process name
X`09`09PRCNAM=PROC_NAME`09; ...
X`09$EXIT_S`09`09`09`09; Return to VMS
XERR_BYE:`09`09`09`09;
X`09$EXIT_S`09R0`09`09`09; Return to VMS with error
X
X`09.END`09LOGIN
$ CALL UNPACK LOGIN.MAR;1 1987804809
$ create 'f'
X`09.TITLE`09HG$SET_KEYSTATE
X`09.IDENT`09"01-001"
X;+
X;  Function:`09HG$SET_KEYSTATE
X;
X;  Author:`09Hunter Goatley   15-MAY-1987
X;`09`09Academic Computing, STH 226
X;`09`09Western Kentucky University
X;`09`09Bowling Green, KY 42101
X;`09`09Voice:`09502-745-5251
X;`09`09E-mail:`09GOATHUNTER@WKUVX1.bitnet
X;`09`09`09GOATHUNTER%wkuvx1@wku.edu
X;
X;  Functional description:
X;
X;`09HG$SET_KEYSTATE performs the same function as the DCL SET KEY/STATE=
X;`09command.
X;
X;  Inputs:
X;
X;`094(AP)`09- Descriptor pointing to the new key state name
X;`098(AP)`09- Address of word to receive length of string returned
X;`09`09  (0 if not desired)
X;`0912(AP)`09- Descriptor pointing to buffer to receive old key state
X;`09`09  (0 if not desired)
X;
X;  Outputs:
X;
X;`09Status in R0`09- SS$_NORMAL, codes returned by STR$COPY_R
X;
X;  Effects:
X;
X;`09Sets and returns DCL Key State
X;
X;  Calling sequence:
X;
X;    STATUS = HG$SET_KEYSTATE ("SETDEF", LENGTH%, OLDSTATE$)
X;-
X
X`09.LIBRARY`09/DCL$KEYLIB:DCLKEY.MLB/
X`09.LINK`09`09/SYS$SYSTEM:SYS.STB/
X`09.LINK`09`09/SYS$SYSTEM:DCLDEF.STB/
X
X`09.PSECT`09_HG$SET_KEYSTATE_CODE,EXE,NOWRT,PIC,SHR
XNEWSTATE`09= 4
XOLDLEN`09`09= 8
XOLDSTATE`09= 12
X`09.ENTRY`09HG$SET_KEYSTATE,`5EM<>
X`09CHECK_ARGS`09#3`09`09`09; Were enough arguments given?
X10$:`09$CMEXEC_S -`09`09`09`09; Need to be in EXEC mode
X`09`09ROUTIN=EXEC_SET_KEYSTATE, -`09; ...
X`09`09ARGLST=(AP)`09`09`09; ...
X`09RET`09`09`09`09`09; Return to caller
X
X`09.ENTRY`09EXEC_SET_KEYSTATE,`5EM<R2,R3,R4,R5,R6,R7,R11>
X`09GET_PRC`09`09`09`09`09; Get the PRC adtress
X`09MOVL`09PRC_L_CURRKEY(R11),R6`09`09; Get address of key state
X`09TSTL`09OLDSTATE(AP)`09`09`09; Did user want old state name?
X`09BEQLU`0910$`09`09`09`09; No - skip it
X`09MOVZBL`09(R6),R0`09`09`09`09; Get the length of the state
X`09PUSHL`09R0`09`09`09`09; Push the length
X`09MOVL`09SP,R0`09`09`09`09; Get the address of the length
X`09PUSHL`09R6`09`09`09`09; Push the string address
X`09INCL`09(SP)`09`09`09`09; Bump it past the length
X`09PUSHAL`09(R0)`09`09`09`09; Push address of length
X`09PUSHL`09OLDSTATE(AP)`09`09`09; Push return desc. address
X`09CALLS`09#3,G`5ESTR$COPY_R`09`09`09; Copy the string to the buffer
X`09POPL`09R1`09`09`09`09; Remove the old length
X`09BLBC`09R0,100$`09`09`09`09; Error?  Return if so
X10$:`09TSTL`09OLDLEN(AP)`09`09`09; Did user want return length?
X`09BEQLU`0920$`09`09`09`09; No - skip it
X`09MOVZBW`09(R6),@OLDLEN(AP)`09`09; Move the length
X20$:`09TSTL`09NEWSTATE(AP)`09`09`09; Did user give new state?
X`09BEQLU`0990$`09`09`09`09; No - skip it
X; R6 --> current key state
X`09MOVQ`09@NEWSTATE(AP),R4`09`09; Get new state descriptor
X`09MOVZWL`09R4,R1`09`09`09`09; Move size to R1
X`09INCL`09R1`09`09`09`09; Bump to include count byte
X`09BSBB`09ALLOSTATE`09`09`09; Get some new memory
X`09MOVL`09R2,PRC_L_CURRKEY(R11)`09`09; Set new state address
X`09MOVB`09R4,(R2)+`09`09`09; Set the new state length
X`09MOVC3`09R4,(R5),(R2)`09`09`09; Set the new keypad state
X`09BSBB`09DEALSTATE`09`09`09; Deallocate the old state
X`09MOVL`09PRC_L_CURRKEY(R11), -`09`09; Copy the key state address
X`09`09PRC_L_LASTKEY(R11)`09`09; ...  to PRC_L_LASTKEY
X90$:`09MOVL`09#SS$_NORMAL,R0`09`09`09; Set return status
X100$:`09RET
X
XDEALSTATE:
X`09PUSHR`09#`5EM<R0,R1,R3>`09`09; Save work registers
X`09MOVAB`09PRC_Q_ALLOCREG(R11),R3`09; Get allocation region listhead
X`09MOVL`09R6,R0`09`09`09; Get address
X`09MOVZBL`09(R0),R1`09`09`09; Get deleted entry size
X`09INCL`09R1`09`09`09; Bump to include length byte
X`09ADDL2`09#7,R1`09`09`09; Truncate to a quadword boundary
X`09BICL2`09#7,R1`09`09`09; Round to next quadword boundary
X`09JSB`09@#EXE$DEALLOCATE`09; Deallocate the memory
X`09POPR`09#`5EM<R0,R1,R3>`09`09; Restore work registers
X`09RSB`09`09`09`09; Return to caller
X
XALLOSTATE:
X`09PUSHR`09#`5EM<R0,R1,R3>`09`09; Save work registers
X`09MOVAB`09PRC_Q_ALLOCREG(R11),R3`09; Get allocation region listhead
X`09ADDL2`09#7,R1`09`09`09; Truncate to a quadword boundary
X`09BICL2`09#7,R1`09`09`09; Round to next quadword boundary
X`09JSB`09@#EXE$ALLOCATE`09`09; Deallocate the memory
X`09POPR`09#`5EM<R0,R1,R3>`09`09; Restore work registers
X`09RSB`09`09`09`09; Return to caller
X
X`09.END
$ CALL UNPACK STATE.MAR;1 105780110
$ v=f$verify(v)
$ EXIT
