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

Download 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

Download 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
 Posted by at 5:33 am