.TITLE HG$DEFINE_KEY .IDENT "01-001" ;+ ; Function: HG$DEFINE_KEY ; ; Author: Hunter Goatley 15-MAY-1987 ; Academic Computing, STH 226 ; Western Kentucky University ; Bowling Green, KY 42101 ; Voice: 502-745-5251 ; E-mail: GOATHUNTER@WKUVX1.bitnet ; GOATHUNTER%wkuvx1@wku.edu ; ; Functional description: ; ; HG$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 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 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 ; 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 ; ... 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 ; 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 ; ... 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