VAX Professional: DCL Key Definition Routines
DCL Key Definition Routines
by
Hunter Goatley
Clyde Digital Systems
The VMS Run-Time Library (VMS RTL) contains a large assortment of commonly needed string manipulation functions (STR$), math functions (MTH$), and various other routines, including some that make the system services easier to call from high-level languages (LIB$). Among the LIB$ routines are some you can call to ask your command language interface (CLI) to perform some functions for you. These include LIB$SET_SYMBOL (define a DCL symbol), LIB$GET_SYMBOL (get the value of a DCL symbol), LIB$SET_LOGICAL (assign logicals from supervisor mode), and routines to delete the symbols and logicals (LIB$DELETE_*).
With VMS version 4.0, user-definable DCL keys came into being. Essentially, the ability to define keys from DCL gives you the ability to tie often-typed DCL commands to a key so that they can be executed literally at the touch of a button. All of the keypad and editing keys can be defined, as well as most of the function keys. The terms “key” and “keypad” are used interchangeably throughout this article to refer to user-definable keys. The general format of the DCL command to define a key is
$ DEFINE/KEY key-name "DCL command to execute"
There are various qualifiers that affect how DCL treats the key definition (echo the command string, terminate the command immediately, etc.). (For a more in-depth look at DEFINE/KEY, see the June 1987 issue of DEC Professional.) To make life more fun, each key can be set up to have a different definition depending on the current key “state.” The default key state is named (what else?) “DEFAULT”. If a key definition is entered without specifying a state (with /STATE=), the key is defined for the current key state. The key will have that definition until the key state is changed ($ SET KEY/STATE=NEWNAME). It didn’t take long for defined DCL keys to invade my way of life under VMS; such things as SHOW USERS and DIR could now be done by pressing one key with one finger. Very handy for lazy typists such as me!
Being a “speed fanatic” (meaning I want such things as logging in done as quickly as possible), I had already written a LOGIN program that my LOGIN.COM executes to set up all of my symbols and define all of my logicals (via the LIB$ routines mentioned above), as well as to perform tasks that normally require the activation of an image (set process name, default protection, etc.). Unfortunately (for me), DEC had not provided LIB$ routines to define DCL keys. In order to DEFINE all of my keys, my wonderfully fast LOGIN program had to call LIB$DO_COMMAND to execute a command procedure that did the key definitions. Needless to say, this slowed my program down some and bugged me (I know, what’s another second or two?). Anyway, not having the LIB$ routines I wanted made me finally sit down and write them myself.
Keypad Definition Internals
Before I talk about my routines, let me discuss how VMS stores keypad definitions. DCL stores all keypad definitions in a process’s P1 space. Each key definition is described by a data structure containing such information as the key name, the equivalence string associated with that key, the key state for which the definition is valid, and more. As with most VMS data structures, the structures are maintained as a doubly-linked list; the first two longwords of each structure point to the previous and next structures in the list. Each key structure is similar to the structures for all DCL symbols; in fact, the same symbolic offsets are used for both types of structures. The offsets are defined in SYS$SYSTEM:DCLDEF.STB and have the prefix SYM_. Any program wishing to use these symbols must be linked with the DCLDEF symbol table.
Figure 1 describes the layout for a key structure under VMS 4.5. Note that some of the fields have meaning for symbol definitions and are unused in keypad definitions. The size of the structure is the total length of all of the components, rounded to the nearest quadword boundary (for better memory allocation).
Keypad definition structure layout
(Symbols defined in SYS$SYSTEM:DCLDEF.STB)
Symbolic offset Offset Meaning
=============== ======== =======
SYM_L_FL 00000000 Forward link in keypad list
SYM_L_BL 00000004 Backward link in keypad list
SYM_L_ORDERED 00000008 Unused
SYM_W_FILELEVEL 0000000C Unused
SYM_W_PROCLEVEL 0000000E Unused (set to -1)
SYM_L_PROCSEQ 00000010 Unused
SYM_W_BLOCKLEVEL 00000014 Unused
SYM_L_BLOCKSEQ 00000016 Unused
SYM_W_SIZE 0000001A Size of keypad definition structure
SYM_B_TYPE 0000001C Structure type (SYM_K_KEYPAD)
SYM_W_FLAGS 0000001D The flags described below (SYM_M_*)
SYM_T_SYMBOL 0000001F Symbol name (ASCIC string)
The remainder of the structure:
WORD - combined lengths of next 3 strings + 4
BYTE - length of IF_STATE string
ASCII if_state string
WORD - length of equivalence string
ASCII equivalence string
BYTE - length of SET_STATE string
ASCII set_state string
SYM_K_KEYPAD 00000004 Symbol is a keypad symbol
SYM_M_ECHO 00000001 /ECHO the command string
SYM_M_TERMINATE 00000002 /TERMINATE the command immediately
SYM_M_STATE 00000004 /SET_STATE - the key should set a state
SYM_M_LOCK 00000008 /LOCK - lock the SET_STATE
SYM_M_ERASE 00000010 /ERASE any characters already entered
Figure 1
CTL$AG_CLIDATA is a system-wide global symbol (defined in SYS$SYSTEM:SYS.STB) that points to the beginning of the memory in a process’s P1 space that can be used by the CLI to store data. DCL defines symbols that are offsets from this location; the symbol we’re interested in is PPD$L_PRC (PPD stands for Process Permanent Data), which points to the PRoCess work area–the area where DCL stores such things as the DCL prompt, the recall command buffer, symbol definitions, and keypad definitions! DCL further defines some symbols as offsets into the PRC area. Again, the symbols we’re interested in are PRC_Q_KEYPAD, PRC_L_CURRKEY, and PRC_L_LASTKEY. (By the way, the symbols I needed for my VAX Professional article on flushing the DCL command buffer are defined in DCLDEFS also. Now I know…)
PRC_Q_KEYPAD is the listhead for the keypad definition list. The quadword contains a forward pointer to the first structure in the list (if present) and a backward pointer to the last structure in the list. If there are no key definitions, both longwords point to PRC_Q_KEYPAD. The key definition structures are sorted alphabetically on two fields: they are sorted primarily by the IF_STATE string and then by key name. (All of the definition structures for a each state are sorted by the state name; the structures within each state are then sorted alphabetically by key name.) When a keypad key is pressed, DCL looks at the current key state and begins searching for the first key defined for that state. Once a key is found, all of the key definitions in that state are searched until the correct entry is found (if it exists at all). The equivalence string is then used as the next DCL command.
Figure 2 shows an actual key definition structure as displayed with the System Dump Analyzer. The only key that has been defined is E1. Note that the unused portions of the structure may contain garbage (depending on what the memory was used for before allocated as a key definition).
$ ! Only the E1 key has been defined
$ DEFINE/KEY E1 "HELP"/terminate/echo/noerase/if_state=CMD
$ ANALYZE/SYSTEM
VAX/VMS System Analyzer
SDA> read sys$system:dcldef ! Read in DCLDEF.STB
SDA> exam ctl$ag_clidata+ppd$l_prc ! Get PRC address
CTL$AG_CLIDATA+008: 7FFE33DC ".3.." ! ...
SDA> define prc = 7ffe33dc ! Define PRC to point there
SDA> exam prc+prc_q_keypad ! Look at forward link
PRC+040: 7FF4A578 "x..." ! ... Points to E1
SDA> exam prc+prc_q_keypad+4 ! Look at backward link
PRC+044: 7FF4A578 "x..." ! ... Also points to E1
SDA> format/type=sym 7ff4a578 ! Format the structure
7FF4A578 SYM_L_FL 7FFE341C ! The forward link
7FF4A57C SYM_L_BL 7FFE341C ! The backward link
7FF4A580 SYM_L_ORDERED 00000000 ! Unused
7FF4A584 SYM_W_FILELEVEL 0000 ! Unused
7FF4A586 SYM_W_PROCLEVEL FFFF ! Unused (set to -1)
7FF4A588 SYM_L_PROCSEQ 00000000 ! Unused
7FF4A58C SYM_W_BLOCKLEVEL 0000 ! Unused
7FF4A58E SYM_L_BLOCKSEQ 0000 ! Unused
7FF4A590 0000 ! Unused
7FF4A592 SYM_W_SIZE 0030 ! Size of this structure
7FF4A594 SYM_B_TYPE 04 ! Type = SYM_K_KEYPAD
7FF4A595 SYM_W_FLAGS 0003 ! Flags=/TERMINATE/NOERASE/ECHO
SYM_W_NONUNIQUE
7FF4A597 SYM_T_SYMBOL "E1" ! The keyname
SDA> exam .;30
FFFF0000 00000000 7FFE341C 7FF4A5A8 .....4.......... 7FF4A578
02000304 00300000 00000000 00000000 ..........0..... 7FF4A588
00005453 494C0004 444D4303 000B3145 E1...CMD..LIST.. 7FF4A598
^ ^ ^ ^
1 2 3 4
4 = Word sum of lengths of next three strings
3 = ASCIC IF_STATE string
2 = ASCIC equivalence command ("LIST")
1 = Length of SET_STATE string (non-existent here)
Figure 2
Actual key definition structure
The two symbols PRC_L_CURRKEY and PRC_L_LASTKEY point to key state names (represented as ASCIC strings). Initially, both locations point to the same ASCIC string: the current keypad state. When a keypad key is pressed, DCL uses the string pointed to by PRC_L_CURRKEY as the current key state by which to find the keypad definition. The reason two pointers are needed is that a key can be defined to change the key state only for the next key, allowing you to have a key that functions much like the GOLD key in EDT. When one of these keys is pressed, the SET_STATE string stored in its definition is made the new key state (PRC_L_CURRKEY points to this new key state name). The next key that is pressed is located by this new state. If the SET_STATE is temporary (the SYM_M_LOCK bit is not set in the SYM_W_FLAGS mask), DCL copies the address at PRC_L_LASTKEY back to PRC_L_CURRKEY after the second key has been pressed. If the SET_STATE is to be locked, the “new” pointer at PRC_L_CURRKEY is copied to PRC_L_LASTKEY, and the process begins all over again. Figure 3 graphically demonstrates what happens when a “GOLD” key is defined.
Assume:
1) Current key state is DEFAULT
2) Two keys have been defined:
$ DEFINE/KEY ENTER "SHOW "/echo/noterminate/set_state=GOLD
$ DEFINE/KEY KP0 "USERS"/echo/terminate/if_state=GOLD
Initially:
PRC_L_LASTKEY --> "DEFAULT" <-- PRC_L_CURRKEY
When ENTER is pressed, the current state becomes "GOLD":
PRC_L_LASTKEY --> "DEFAULT"
PRC_L_CURRKEY --> "GOLD"
After KP0 is pressed, the current state becomes "DEFAULT" again:
PRC_L_LASTKEY --> "DEFAULT" <-- PRC_L_CURRKEY
Figure 3
"GOLD" key example showing the effects on the
pointers to the current key state
All of the DCL key definition routines allocate memory from a process’s P1 space. The system routines EXE$ALLOCATE and EXE$DEALLOCATE are used to allocate and deallocate the memory as needed. The actual DCL routines also use these routines, instead of EXE$ALOP1PROC and EXE$DEAP1. The free P1 memory listhead can be found at PRC_Q_ALLOCREG.
The Routines
After figuring out how DCL handled keypad definitions, I wrote a few routines that could be called from a program to perform the same functions. The bad news (?) about the routines is that they must run in executive mode. The P1 space that is used to store the key definitions is protected from user and supervisor modes, so each routine goes into executive mode to do its work. The routines I wrote are
- HG$DEFINE_KEY — defines a DCL key
- HG$GET_KEYDEF — returns the definition of a DCL key
- HG$DELETE_KEY — deletes a DCL keypad definition
- HG$FIND_KEY — finds the location in the linked list for a key
- HG$SET_KEYSTATE — changes the current key state (and returns old)
Program 1 is made up of these routines. One obvious feature that is missing from these routines is the check for a valid key name. It is possible to use these routines to define keys that don’t really exist (perhaps you can find some use for this). I didn’t feel like writing that routine because I knew that I wasn’t going to try to define a non-existent key. I also leave it up to you to work the routines into a privileged shareable image (if desired) to allow non-privileged users to call these routines.
These routines work “as is” for VMS 4.5. Earlier versions of VMS (prior to VMS 4.4) differ in the layout of the keypad definition structures. For VMS 4.1 the structures are 19 bytes smaller. In HG$DEFINE_KEY and HG$GET_KEYDEF, I have defined the symbol “VMS4_5”; if you are running VMS v4.1, simply remove that symbol definition and the routines will assemble correctly.
The routines presented in Program 1 should be split into separate files and could then be placed in an object library. The commands to do this are
$ DEFINE DCL$KEYLIB disk:[dir] $ LIBRARY/MACRO/CREATE DCLKEY.MLB DCLKEYMACS.MAR $ MACRO DEFINE,DELETE,STATE,FIND,GETDEF $ LIBRARY/OBJECT/CREATE DCLKEY.OLB _*.OBJ $
The LOGIN program
I have included (Program 2) a small version of my LOGIN program to show you how you can use HG$DEFINE_KEY to define your keys from a program. LOGIN also defines symbols and logicals using the LIB$ routines mentioned at the beginning of this article. Because all of the data used is actually stored in the executable image, the routines do extra work to set up string descriptors for each symbol, logical, and key definition to cut down on the amount of disk space needed for the program (a savings of 14 bytes for each pair of symbol and logical definitions is achieved by storing them as ASCIC strings instead of ASCID). The program can be expanded to perform more of the functions your LOGIN.COM is currently doing. For example, calls to system services can be made to set your RMS default protection, turn on privileges, etc.
To build the LOGIN program, execute the following commands:
$ MACRO LOGIN $ LINK LOGIN,DCLKEYS/LIBRARY $ RUN LOGIN
Note that if you don’t have a lot for LOGIN to do, it may not be faster than letting your LOGIN.COM do the work. My LOGIN defines more than 190 logicals, symbols, and keys (as well as setting process name, etc.), and there is quite a difference in the time it takes for me to log in now compared to the old way. Whether or not you find these routines useful, you now have some idea of the behind-the-scenes action of DCL keypad usage.
Biographical Information:
Hunter Goatley, a graduate in Computer Science from Western Kentucky University, is currently working as a programmer/analyst for Clyde Digital Systems, Orem, Utah.
DCLKEYS.MAR
;=============== 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
LOGIN.MAR
.TITLE LOGIN.MAR Set up environment at LOGIN
;========================================================================
;= =
;= Programmer: Hunter Goatley =
;= Program: LOGIN.MAR =
;= System: VAX 11/785 VAX/VMS v4.2 =
;= Date: December 7, 1985 =
;= Purpose: Define logicals and foreign commands and other =
;= miscellaneous things =
;= =
;========================================================================
;
; MACRO EQUAL => Set up memory for each string and its
; equivalence string. .ASCIC is used.
.MACRO EQUAL SYMBOL,EQUIV
.ASCIC ?EQUIV?
.ASCIC ?SYMBOL?
.ENDM EQUAL
;
; KEY$KEYDEF => Set up memory for keypad definitions.
.MACRO KEY$KEYDEF KEY,EQUIV,IF_STATE=KDEFAULT,SET_STATE=0,FLAGS=FLAG1
.BYTE FLAGS ; Offset into FLAGS table
.BYTE SET_STATE ; Offset into STATE name table
.BYTE IF_STATE ; Offset into STATE name table
.ASCIC \EQUIV\ ; Equivalence string
.ASCIC \KEY\ ; Key name
.ENDM KEY$KEYDEF
.MACRO BUILD_DESCS
MOVZBW (R8)+,(R6) ; Move the string length to the desc.
MOVL R8,4(R6) ; Move the string address to the desc.
MOVZWL (R6),-(SP) ; Move the length to stack (word->long)
ADDL2 (SP)+,R8 ; Add to get addr of next string (count)
;
MOVZBW (R8)+,(R7) ; Move the string length to the desc.
MOVL R8,4(R7) ; Move the string address to the desc.
MOVZWL (R7),-(SP) ; Move the length to stack (word->long)
ADDL2 (SP)+,R8 ; Add to get addr of next string (count)
.ENDM BUILD_DESCS
.PSECT DATA,LONG,NOEXE,WRT
;
;====== The descriptor to be used for all equivalence strings.
EQUIV_DESC:
.WORD 0 ; Soon to be the length of the string
.BYTE DSC$K_DTYPE_T ; The type of string (character)
.BYTE DSC$K_CLASS_S ; The class (static)
.LONG 0 ; Soon to be the address
;===== The descriptor to be used for all logical names, symbol names, and
;===== keys to be defined.
SYM_LOG_DESC:
.WORD 0 ; Soon to be the length of the string
.BYTE DSC$K_DTYPE_T ; The type of string (character)
.BYTE DSC$K_CLASS_S ; The class (static)
.LONG 0 ; Soon to be the address
;
SYM_TABLE: .LONG LIB$K_CLI_GLOBAL_SYM ; Global symbol table-id
;
LOGICALS: ; The logicals to define
EQUAL <WORK>,<WKU$USER:[AC012116.WORK]>
EQUAL <DBG$INIT>,<WORK:DBGINI.DBG>
EQUAL <TPUSECINI>,<WORK:HUNTER.TPU$SECTION>
EQUAL <LNK$LIBRARY>,<SYS$LIBRARY:VAXCRTL>
.LONG 0 ; Terminate with 0
.ALIGN LONG
SYMBOLS: ; The symbols to set
EQUAL <AUDIT>,<$CDS$EXE:AUDIT.EXE>
EQUAL <CONTRL>,<$CDS$EXE:CONTRL>
EQUAL <KBLOCK>,<$CDS$EXE:KBLOCK>
EQUAL <T*YPE>,<TYPE>
EQUAL <WKUMON>,<$WORK:WKUMON.EXE>
.LONG 0 ; Terminate with a 0
.ALIGN LONG
KDEFAULT= 1
KCMD = 2
KSETDEF = 3
STATE_TABLE: ; Key state names vector table
.LONG 0 ; Null
.ADDRESS KDEFAULT_D ; state DEFAULT
.ADDRESS KCMD_D ; state CMD
.ADDRESS KSETDEF_D ; state SETDEF
KDEFAULT_D: .ASCID /DEFAULT/ ; ...
KCMD_D: .ASCID /CMD/ ; ...
KSETDEF_D: .ASCID /SETDEF/ ; ...
FLAG1 = 0 ; /ERASE/TERMINATE/ECHO
FLAG2 = 1 ; /ERASE/ECHO/SET_STATE
FLAG3 = 2 ; /ERASE/ECHO/NOTERMINATE
FLAG4 = 3 ; /NOERASE/ECHO/TERMINATE
FLAGS_TABLE:
.LONG SYM_M_ERASE!SYM_M_TERMINATE!SYM_M_ECHO
.LONG SYM_M_ERASE!SYM_M_ECHO!SYM_M_STATE
.LONG SYM_M_ERASE!SYM_M_ECHO
.LONG SYM_M_TERMINATE!SYM_M_ECHO
KEYS_TABLE:
KEY$KEYDEF <KP7>,<SHOW USERS>,,,FLAG1
KEY$KEYDEF <PF1>,<SET TERMINAL/NUMERIC>,,,FLAG1
KEY$KEYDEF <PF1>,<SET TERMINAL/NUMERIC>,KSETDEF,,FLAG1
KEY$KEYDEF <ENTER>,<SD >,,KSETDEF,FLAG2
KEY$KEYDEF <DO>,<CMD/>,,KCMD,FLAG2
;Key definitions for state DEFAULT ;
KEY$KEYDEF <E1>,<WKUmon>,,,FLAG1
KEY$KEYDEF <HELP>,<HELP >,,,FLAG3
;Key definitions for state SETDEF ;
KEY$KEYDEF <KP0>,<*>,KSETDEF,,FLAG4
KEY$KEYDEF <ENTER>,<SHOW DEFAULT>,KSETDEF,,FLAG1
; Key definitions for state CMD
KEY$KEYDEF <E1>,<LIST>,KCMD,,FLAG4
KEY$KEYDEF <E2>,<RESTORE>,KCMD,,FLAG4
KEY$KEYDEF <E3>,<FLUSH>,KCMD,,FLAG4
KEY$KEYDEF <E4>,<SAVE>,KCMD,,FLAG4
KEY$KEYDEF <E5>,<BOTH>,KCMD,,FLAG4
.LONG 0 ; Terminate with null longword
.ALIGN LONG
PROC_NAME: ; The process name to set
.ASCID /Goat Busters/
.PSECT LOGIN,EXE,NOWRT
.ENTRY LOGIN,^M<>
; Define all logicals for the process
MOVAB LOGICALS,R8 ; Get the beginning of the first symbol
MOVAQ EQUIV_DESC,R6 ; Get address of equivalence descriptor
MOVAQ SYM_LOG_DESC,R7 ; Get address of LOGICAL descriptor
10$: TSTB (R8) ; Are we finished (0 length)?
BEQLU DO_SYM ; Yes -- leave
BUILD_DESCS ; Build the string descriptors
PUSHL R6 ; Push addr of the equiv descriptor
PUSHL R7 ; Push addr of the logical descriptor
CALLS #2,G^LIB$SET_LOGICAL ; Go define it
BRB 10$ ; Loop until done
; Define all symbols for the process
DO_SYM:
MOVAB SYMBOLS,R8 ; Get the beginning of the first symbol
MOVAL SYM_TABLE,R9 ; Move the address of the table-id to R9
20$: TSTB (R8) ; Are we finished (0 length)?
BEQLU DO_KEYS ; Yes -- leave
BUILD_DESCS ; Set up the string descriptors
PUSHL R9 ; Push the address of table-id (global)
PUSHL R6 ; Push addr of the equiv descriptor
PUSHL R7 ; Push addr of the logical descriptor
CALLS #3,G^LIB$SET_SYMBOL ; Go define it
BRB 20$ ; Loop until done
; Define all keys for the process
DO_KEYS:
MOVAB KEYS_TABLE,R8 ; Get the beginning of the first symbol
MOVAQ EQUIV_DESC,R6 ; Get address of equivalence descriptor
MOVAQ SYM_LOG_DESC,R7 ; Get address of LOGICAL descriptor
30$: TSTL (R8) ; Are we finished (0 length)?
BEQLU DO_REST ; Yes -- leave
MOVZBL (R8)+,R0 ; Get offset in vector table
PUSHAL FLAGS_TABLE[R0] ; ...
MOVZBL (R8)+,R0 ; Get offset in vector table
PUSHL STATE_TABLE[R0] ; ...
MOVZBL (R8)+,R0 ; Get offset in vector table
PUSHL STATE_TABLE[R0] ; ...
BUILD_DESCS ; Build the string descriptors
PUSHL R6 ; Push addr of the equiv descriptor
PUSHL R7 ; Push addr of the logical descriptor
CALLS #5,HG$DEFINE_KEY ; Go define it
BRB 30$ ; Loop until finished
;
DO_REST: ;
$SETPRN_S - ; Set the process name
PRCNAM=PROC_NAME ; ...
$EXIT_S ; Return to VMS
ERR_BYE: ;
$EXIT_S R0 ; Return to VMS with error
.END LOGIN