From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 17-NOV-1989 15:43
To:	MRGATE::"ARISIA::EVERHART"
Subj:	Programs From Hunter Goatley of Clyde  1/2

Message-Id:  <8911171949.AA08135@crdgw1.ge.com>
Received: From AAMRL.AF.MIL by CRVAX.SRI.COM with TCP; Fri, 17 NOV 89 10:01:57 PDT
Received: from FALCON by AAMRL.AF.MIL; Fri, 17 Nov 89 12:58 EDT
Date: Fri, 17 Nov 89 12:58 EST
From: Ted Nieland <@AAMRL.AF.MIL:TNIELAND@FALCON>
Subject: Programs From Hunter Goatley of Clyde  1/2
To: info-vax@sri.COM
X-Vms-To: IN%"info-vax@sri.com"

$! ------------------ CUT HERE -----------------------
$!
$! This archive created by VMS_SHARE Version 7.1-001  26-JUN-1989
$!   On 17-NOV-1989 12:52:57.18   By user TNIELAND 
$!
$! This VMS_SHARE Written by:
$!    Andy Harper, Kings College London UK
$!
$! Acknowledgements to:
$!    James Gray       - Original VMS_SHARE
$!    Michael Bednarek - Original Concept and implementation
$!
$!+ THIS PACKAGE DISTRIBUTED IN 2 PARTS, TO KEEP EACH PART
$!  BELOW 100 BLOCKS
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. AAAREADME.TXT;1
$!       2. DCL_RECALL_PATCH.TXT;1
$!       3. CMD.MAR;1
$!       4. DCLKEYS.MAR;1
$!       5. HG$GET_INPUT.MAR;1
$!       6. LOGIN.MAR;1
$!       7. SET_DCL_PROMPT.MAR;1
$!       8. DCL_RECALL_V5_0.PATCH;1
$!       9. DCL_RECALL_V5_2.PATCH;1
$!
$f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if f$trnlnm("SHARE_LOG") then $ w = "!"
$ if f$getsyi("version") .ges. "4.4" then $ goto START
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ exit 44
$UNPACK: SUBROUTINE ! P1=filename, P2=checksum
$ if f$search(P1) .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped."
$ delete/nolog 'f'*
$ exit
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'."
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped."
$ delete/nolog 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'
PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");
buff:=CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(buff))
;LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(buff));g:=0;LOOP EXITIF MARK(NONE)=END_OF(buff);x:=
ERASE_CHARACTER(1);IF g = 0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x=
"V" THEN APPEND_LINE;MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;
IF x="+" THEN g:=1;ERASE_LINE;ENDIF;ELSE IF x="-" THEN g:=0;ENDIF;ERASE_LINE;
ENDIF;ENDLOOP;p:="`";POSITION(BEGINNING_OF(buff));LOOP r:=SEARCH(p,FORWARD);
EXITIF r=0;POSITION(r);ERASE(r);COPY_TEXT(ASCII(INT(ERASE_CHARACTER(3))));
ENDLOOP;o:=GET_INFO(COMMAND_LINE,"output_file");WRITE_FILE(buff,o);
ENDPROCEDURE;Unpacker;EXIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create/nolog 'f'
XThis submission (hurriedly thrown together after DECUS Fall '89) contains th
Ve
Xsource files for several of my VAX PROFESSIONAL articles over the last coupl
Ve
Xof years (sort of a "Best of" collection).
X
XI hope you find them useful.
X
XThe following modules have been included in this short submission:
X
XCMD.MAR`009`009`009Save, Restore, Flush, and List your DCL command buffer.
X`009`009`009First appeared in VAX PROFESSIONAL.
X
XDCLKEYS.MAR`009`009File containing the various modules for "DCL Key
X`009`009`009Definition Routines", VAX PROFESSIONAL, Feb. 1988.
X
XDCL_RECALL_PATCH.TXT`009Instructions for the following patch files (first
X`009`009`009appeared in VAX PROFESSIONAL, December 1988).
X
XDCL_RECALL_V5_0.PATCH`009A PATCH file to patch DCL.EXE for VMS V5.0 so that
X`009`009`009more than 20 commands can be recalled.
X
XDCL_RECALL_V5_2.PATCH`009A PATCH file to patch DCL.EXE for VMS V5.2 so that
X`009`009`009more than 20 commands can be recalled.
X
XHG$GET_INPUT.MAR`009Callable routine that can be called instead of
X`009`009`009LIB$GET_INPUT to allow command recall (first appeared
X`009`009`009in VAX PROFESSIONAL, February 1989.  See comments
X`009`009`009for calling sequence.
X
XLOGIN.MAR`009`009A VMS LOGIN program that defines symbols, logicals,
X`009`009`009and a bunch of other things to replace LOGIN.COM.
X`009`009`009First appeared in VAX PROFESSIONAL (April 1989) and
X`009`009`009was the subject of DECUS Fall '89 Session VA113 in
X`009`009`009Anaheim.
X
XSET_DCL_PROMPT.MAR`009A callable routine to let you change your DCL prompt.
X`009`009`009Extracted from LOGIN.MAR.
X
XI welcome any comments or suggestions you may have.
X
XHunter Goatley
XSenior Systems Programmer
XClyde Digital Systems
X371 East 800 South
XOrem, Utah  84058
X(801) 224-5306
X
$ CALL UNPACK AAAREADME.TXT;1 2015748232
$ create/nolog 'f'
XThe DCL recall patches modify DCL so that more than 20 commands can be recal
Vled
X(via either the arrow-keys or the DCL command RECALL).
X
XFor safety's sake, I recommend that you first make a copy of DCL.EXE:
X
X`009$ COPY SYS$SYSTEM:DCL.EXE SYS$SYSTEM:DCL_ORIG.EXE
X
XThis way, if things get real messed up, you can go back to your original DCL
V.
X
XTo install the patches, I suggest copying DCL.EXE from SYS$SYSTEM: to your
Xdefault directory and using the following command:
X
X`009$ PATCH @DCL_RECALL_V5_x.PATCH
X
XWhen the patch completes, you will have a new DCL.EXE that can be copied bac
Vk
Xto SYS$SYSTEM:.
X
XOnce the file has been copied back, you should use INSTALL so that the new
XDCL.EXE will be loaded:
X
X`009$ INSTALL REPLACE SYS$SYSTEM:DCL.EXE
X
X
XSo:
X
X`009$ COPY SYS$SYSTEM:DCL.EXE SYS$SYSTEM:DCL_ORIG.EXE
X`009$ COPY SYS$SYSTEM:DCL.EXE `091`093
X`009$ PATCH @DCL_RECALL_V5_2.PATCH
X`009$ COPY DCL.EXE SYS$SYSTEM:
X`009$ SET PROT=W:E SYS$SYSTEM:DCL.EXE
X`009$ INSTALL REPLACE SYS$SYSTEM:DCL.EXE
X
X
X
XHunter Goatley
XSenior Systems Programmer
XClyde Digital
X371 East 800 South
XOrem, Utah  84058
X(801) 224-5306
$ CALL UNPACK DCL_RECALL_PATCH.TXT;1 1364704289
$ create/nolog 'f'
X;========================================================================
X;=`009`009`009`009`009`009`009`009`009=
X;=`009Programmer:`009Hunter Goatley, Clyde Digital Systems, Orem, UT`009=
X;=`009Program:`009CMD.MAR`009`009`009`009`009`009=
X;=`009Purpose:`009Save, restore, flush, & list DCL command buffer`009=
X;=`009Language:`009VAX-11 MACRO32  assembly language`009`009=
X;=`009System:`009`009VAX/VMS v4.x`009`009`009`009`009=
X;=`009Date:`009`009October 8, 1986`009`009`009`009`009=
X;=`009`009`009`009`009`009`009`009`009=
X;========================================================================
X;=`009`009`009`009`009`009`009`009`009=
X;=`009Copyright (c) 1989 by Hunter Goatley`009`009`009`009=
X;=`009`009`009`009`009`009`009`009`009=
X;=`009This program may be distributed freely for non-profit use`009=
X;=`009as long as this notice remains intact.`009`009`009`009=
X;=`009`009`009`009`009`009`009`009`009=
X;========================================================================
X;=`009`009`009`009`009`009`009`009`009=
X;=`009`009`009`009`009`009`009`009`009=
X;=`009This  program  allows  the user to flush the command buffer,`009=
X;=`009list all of the commands in  the buffer,  write the contents`009=
X;=`009of the buffer to a file, and restore the buffer from a file.`009=
X;=`009`009`009`009`009`009`009`009`009=
X;=`009To use this program, set up a foreign symbol, such as:`009`009=
X;=`009`009`009`009`009`009`009`009`009=
X;=`009`009`009$ CMD :== $dev:`091dir`093CMD.EXE`009`009`009=
X;=`009`009`009$ CMD/qualifier`009`009`009`009`009=
X;=`009`009`009`009`009`009`009`009`009=
X;=`009To build:`009`009`009`009`009`009`009=
X;=`009`009`009$ MACRO CMD`009`009`009`009`009=
X;=`009`009`009$ LINK CMD/NOTRACEBACK`009`009`009`009=
X;=`009`009`009`009`009`009`009`009`009=
X;=`009To install:`009`009`009`009`009`009`009=
X;=`009`009`009$ INSTALL ADD CMD.EXE/PRIV=CMEXEC`009`009=
X;=`009`009`009`009`009`009`009`009`009=
X;=`009`009`009`009`009`009`009`009`009=
X;=`009The valid qualifiers are:`009`009`009`009`009=
X;=`009`009`009`009`009`009`009`009`009=
X;=`009/LIST`009-  List all commands in the DCL command buffer`009`009=
X;=`009/SAVE`009-  Save the commands in SYS$LOGIN:SAVE_CMDS.TXT`009`009=
X;=`009/RESTORE-  Restore commands previously SAVEd`009`009`009=
X;=`009/FLUSH`009-  Flush the command buffer`009`009`009`009=
X;=`009/BOTH`009-  SAVE, then FLUSH the DCL command buffer`009`009=
X;=`009`009`009`009`009`009`009`009`009=
X;========================================================================
X;
X`009.LINK`009"SYS$SYSTEM:SYS.STB"/selective_search
X`009.LINK`009"SYS$SYSTEM:DCLDEF.STB"/selective_search
X
X;
X;  This macro compares the current address (in R10) with the beginning addre
Vss
X;  of the data area -- if they are equal, set the current address = to the e
Vnd
X;  of the data block (wrap).
X;
X`009.MACRO`009CHECK`009?HERE
X`009CMPL`009R11,R10`009`009`009; Have we gone past the beginning?
X`009BNEQ`009HERE`009`009`009; No -- skip next instruction
X`009MOVAB`009PRC_G_COMMANDS(R3),R10
X`009ADDL2`009#PRC_S_COMMANDS+1,R10
X;`009MOVL`009#CMD_BUF_END,R10`009; Make R10 point to one byte past the
X`009`009`009`009`009; ... end of the data area.  With next
X`009`009`009`009`009; ... autodecrement, it will point to
X`009`009`009`009`009; ... the last byte of the table.
X HERE:`009.ENDM`009CHECK
X`009`009`009`009`009;
X;
X;  This macro compares the first four bytes of FOR_BUFF with a valid qualifi
Ver.
X;  If there is a match, the appropriate routine is called and control branch
Ves
X;  to return to VMS.
X;
X`009.MACRO`009PRESENT`009QUAL,ROUTIN1,ROUTIN2=0,?LABEL
X`009CMPL`009#`094A\QUAL\,FOR_BUFF`009; Was /QUAL given?
X`009BNEQU`009LABEL`009`009`009; No - try next
X`009CALLS`009#0,ROUTIN1`009`009; Call the proper routine
X`009.IF`009DIF`0090,ROUTIN2`009; Was a second routine given?
X`009BLBC`009R0,BYE`009`009`009; Error?
X`009CALLS`009#0,ROUTIN2`009`009; No - call the second routine
X`009.ENDC`009`009`009`009; ...
X`009BRW`009BYE`009`009`009; Return to VMS (only one qualifier
XLABEL:`009.ENDM`009PRESENT`009`009`009; ...  at a time!!!
X
X`009.PSECT`009DCL_CMDS_DATA,NOEXE,WRT,LONG
X`009`009`009`009`009;
X`009$SSDEF`009`009`009`009; Include status symbols
X`009$RMSDEF`009`009`009`009; Include RMS symbols
X`009$FABDEF`009`009`009`009; Include $FAB symbols
X`009$RABDEF`009`009`009`009; Include $RAB symbols
X`009$PRVDEF`009`009`009`009; Include privilege symbols
X;
X;=======================================================================
X;
XCMDFAB: $FAB`009FNM=<SYS$LOGIN:SAVE_CMDS.TXT>, -`009; File name
X`009`009FAC=<GET,PUT>, -`009`009; File ACcess (R/W only)
X`009`009MRS=1420, -`009`009`009; Maximum Record Size
X`009`009RAT=CR, -`009`009`009; Record ATtributes
X`009`009ORG=SEQ`009`009`009`009; File Organization (sequential)
X;
X;***  Record Access Block for SAVE_CMDS.TXT
X;
XCMDRAB:
X`009$RAB    FAB=CMDFAB, -`009`009; Record Access Block
X`009`009RBF=CMDREC, -`009`009; If writing, write from CMDREC
X`009`009UBF=CMDREC`009`009; Address of SAVE_CMDS record buffer
X
X;
X;
XCMDREC:`009.BLKB`0091032`009`009`009; Buffer for DCL commands
X;
X;=======================================================================
X;
XMAXCMDLEN = 256`009`009`009`009; Maximum length of a DCL command
X`009`009`009`009`009;
XCMDBUFFER_D:`009`009`009`009; Descriptor for the command buffer
X`009.WORD`009MAXCMDLEN`009`009; ...
X`009.BYTE`009DSC$K_DTYPE_T`009`009; ...
X`009.BYTE`009DSC$K_CLASS_S`009`009; ...
X`009.ADDRESS .+4`009`009`009; ...
XCMDBUFFER:`009`009`009`009; The command buffer
X`009.BYTE`009`094A/ /`091MAXCMDLEN`093`009; ...
X`009`009`009`009`009;
XFAOCTR:`009.ASCID`009/!3UL !AS/
XFAOUT:`009.WORD`009256`009`009`009`009; ...
X`009.BYTE`009DSC$K_DTYPE_T`009`009`009; ...
X`009.BYTE`009DSC$K_CLASS_S`009`009`009; ...
X`009.ADDRESS .+4`009`009`009`009; ...
X`009.BLKB`009256
X
XFOR_BUFF_D:`009`009`009`009; Descriptor for the command line
X`009.WORD`009MAXCMDLEN`009`009; ...  returned by LIB$GET_FOREIGN
X`009.BYTE`009DSC$K_DTYPE_T`009`009; ...
X`009.BYTE`009DSC$K_CLASS_S`009`009; ...
X`009.ADDRESS .+4`009`009`009; ...
XFOR_BUFF:`009`009`009`009; BUffer holding the command line
X`009.BLKB`009MAXCMDLEN`009`009; ...
XFOR_LEN:.LONG`0090`009`009`009; Length of command line returned
XUSAGE_D:`009`009`009`009; Usage message
X`009.ASCID`009-
X \Must give valid qualifier: /LIST, /FLUSH, /SAVE, /RESTORE, /BOTH (save,flu
Vsh)\
XCMEXEC:`009.QUAD`009PRV$M_CMEXEC`009`009; Privilege needed to flush & restor
Ve
XCMKRNL:`009.QUAD`009PRV$M_CMKRNL`009`009; Alternative privilege needed
X;
X;===========================================================================
V====
X;
X`009.PSECT`009DCL_CMDS,EXE,NOWRT
X`009.ENTRY`009DCL_CMDS,`094M<>
X
X`009MOVW`009#PRC_S_COMMANDS+4,-`009; Store the size of the command buffer
X`009`009CMDRAB+RAB$W_RSZ`009; ... in the RAB
X`009MOVW`009#PRC_S_COMMANDS+4,-`009; Store the size of the command buffer
X`009`009CMDRAB+RAB$W_USZ`009; ... in the RAB
X
X; A simple command line parser follows.  The code simply checks for a "/"
X; followed by at least 3 characters of the command qualifier.  Not very
X; forgiving, but easy to code.
X;
X`009PUSHAW`009FOR_LEN`009`009`009; Get any commands on command line
X`009PUSHL`009#0`009`009`009; Don't want to prompt for anything
X`009PUSHAQ`009FOR_BUFF_D`009`009; Buffer for command line
X`009CALLS`009#3,G`094LIB$GET_FOREIGN`009; Get the command line
X`009TSTW`009FOR_LEN`009`009`009; Was anything given?
X`009BNEQ`00910$`009`009`009; Yes  - see what was
X`009PUSHAQ`009USAGE_D`009`009`009; No - print usage message
X`009CALLS`009#1,G`094LIB$PUT_OUTPUT`009; ...
X`009BRW`009BYE`009`009`009; ...
X`009`009`009`009`009;
X10$:`009PRESENT`009</RES>,RESTORE_CMDS`009`009; Was /RESTORE given?
X`009PRESENT`009</LIS>,LIST_CMDS`009`009; Was /LIST?
X`009PRESENT`009</FLU>,FLUSH_CMDS`009`009; Was /FLUSH?
X`009PRESENT`009</SAV>,SAVE_CMDS`009`009; Was /SAVE?
X`009PRESENT`009</BOT>,SAVE_CMDS,FLUSH_CMDS`009; Was /BOTH (save and flush)?
X
X`009PUSHAQ`009USAGE_D`009`009`009; If here, a valid qualifier was not
X`009CALLS`009#1,G`094LIB$PUT_OUTPUT`009; ...  given - print USAGE message
X BYE:`009$EXIT_S`009CODE=R0`009`009`009; Exit to VMS
X`009`009`009`009`009;
X;===========================================================================
V====
X;   Subroutine SAVE_CMDS - Save the DCL commands in SYS$LOGIN:SAVE_CMDS.TXT
X;
X`009.ENTRY`009SAVE_CMDS,`094M<>
X`009`009`009`009`009`009;
X`009$CREATE`009FAB=CMDFAB`009`009`009; Create the output file
X`009BLBC`009R0,100$`009`009`009`009; Error?
X    `009$CONNECT RAB=CMDRAB`009`009`009; Connect the RAB
X`009BLBC`009R0,100$`009`009`009`009; Error?
X`009MOVAB`009G`094CTL$AG_CLIDATA,R3`009`009; Get address of CLI data
X`009MOVL`009PPD$L_PRC(R3),R3`009`009; Get address of PRC region
X`009MOVC3`009#PRC_S_COMMANDS+4, -`009`009; Get the DCL previous command
X`009`009PRC_L_RECALLPTR(R3),CMDREC`009; ... buffer (not protected
X`009`009`009`009`009`009; ... against user-mode reads)
X`009$PUT`009RAB=CMDRAB`009`009`009; Write the buffer to the file
X`009BLBC`009R0,100$`009`009`009`009; Error?
X`009$CLOSE`009FAB=CMDFAB`009`009`009; Close the file
X 100$:`009RET`009`009`009`009`009; Return to caller
X`009`009`009`009`009`009;
X;===========================================================================
V====
X;   Subroutine RESTORE_CMDS - Restore DCL commands in SYS$LOGIN:SAVE_CMDS.TX
VT
X;   Calls EXEC_RESTORE from EXECUTIVE mode
X;
X`009.ENTRY`009RESTORE_CMDS,`094M<>
X`009`009`009`009`009`009;
X`009CALLS`009#0,GETPRV`009`009`009; Turn on the CMEXEC to do this
X`009BLBC`009R0,10$`009`009`009`009; If error (No priv), return
X`009$OPEN`009FAB=CMDFAB`009`009`009; Open SAVE_CMDS.TXT for reading
X`009BLBC`009R0,10$`009`009`009`009; Error?
X`009$CONNECT RAB=CMDRAB`009`009`009; Connect the RAB
X`009BLBC`009R0,10$`009`009`009`009; Error?
X`009$GET`009RAB=CMDRAB`009`009`009; Read the only record in the
X`009`009`009`009`009`009; ... file (the command buffer)
X`009BLBC`009R0,10$`009`009`009`009; Error?
X`009$CMEXEC_S -`009`009`009`009; Go move the command buffer
X`009`009ROUTIN=EXEC_RESTORE`009`009; ... to process space
X`009$CLOSE`009FAB=CMDFAB`009`009`009; Close the file
X 10$:`009RET`009`009`009`009`009; Return to caller
X;
X;===========================================================================
V====
X;****`009This executive mode routine moves the previous commands from CMDREC
X;****`009to the CLI data area.
X;
X`009.ENTRY`009EXEC_RESTORE,`094M<>
X`009`009   `009`009`009`009;
X`009MOVAL`009HANDLER,(FP)`009`009`009; Unnecessary handler, but...
X`009MOVAB`009G`094CTL$AG_CLIDATA,R3`009`009; Get address of CLI data
X`009MOVL`009PPD$L_PRC(R3),R3`009`009; Get address of PRC region
X`009MOVC3`009#PRC_S_COMMANDS+4,CMDREC, -`009; Move the prev command block
X`009`009PRC_L_RECALLPTR(R3)`009`009; ...  to the CLI data area
X`009MOVZBL`009#SS$_NORMAL,R0`009`009`009; Set up a success return
X`009RET`009`009`009`009`009; Return to caller
X`009`009`009`009`009`009;
X`009.ENTRY`009HANDLER,`094M<>`009`009`009; Exit handler in case of
X`009$EXIT_S`009`009`009`009`009; ... $ACCVIO (Kill process)
X`009`009`009`009`009`009;
X;===========================================================================
V====
X;   Subroutine LIST_CMDS - List all commands stored in DCL RECALL buffer
X;
X`009.ENTRY`009LIST_CMDS,`094M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
X`009MOVAB`009G`094CTL$AG_CLIDATA,R3`009`009; Get address of CLI data
X`009MOVL`009PPD$L_PRC(R3),R3`009`009; Get address of PRC region
X`009MOVL`009PRC_L_RECALLPTR(R3),R10`009; Get addr of end of most recent cmd
X`009MOVL`009R10,R9`009`009`009; Make a copy of it
X`009MOVAB`009PRC_G_COMMANDS(R3),R11`009; Get the beginning of the data block
X`009CLRL`009R6`009`009`009; Clear command counter
X 10$:`009MOVAB`009CMDBUFFER,R8`009`009; Get the buffer address
X`009`009   `009`009`009; Clear the buffer
X`009MOVZBL`009-(R10),R7`009`009; Get the length of the first command
X`009BNEQ`00920$
X`009BRW`00940$`009`009`009; 2 null bytes in a row? End
X 20$:`009MOVW`009R7,CMDBUFFER_D`009`009; Move the length to the descriptor
X`009CHECK`009`009`009`009; Check to see if this command wraps
X`009`009`009`009`009; ...  to the end of the data area
X`009ADDL2`009R7,R8`009`009`009; Make R8 point to end of buffer
X 30$:`009MOVB`009-(R10),-(R8)`009`009; Move the first byte
X`009CHECK`009`009`009`009; Check our addresses
X`009SOBGTR`009R7,30$`009`009`009; Loop until command is moved
X`009INCL`009R6`009`009`009; Bump the command counter
X`009$FAO_S`009CTRSTR=FAOCTR, -`009; Format for output
X`009`009OUTBUF=FAOUT, -`009`009; ...
X`009`009OUTLEN=FAOUT, -`009`009; ...
X`009`009P1=R6, -`009`009; ...
X`009`009P2=#CMDBUFFER_D`009`009; ...
X`009PUSHAQ`009FAOUT`009`009`009; Write it to the terminal
X`009CALLS`009#1,G`094LIB$PUT_OUTPUT`009; ....
X`009MOVW`009#256,FAOUT`009`009; Reset FAO output descriptor
X`009DECL`009R10`009`009`009; Should now point to prefix count
X`009CHECK`009`009`009`009; Check our addresses
X`009DECL`009R10`009`009`009; Should now point to 0 byte
X`009CHECK`009`009`009`009; Check our addresses
X`009CMPL`009R10,R9`009`009`009; If current addr = starting addr
X`009BEQL`00940$`009`009`009; ...  end of data
X`009BRW`00910$`009`009`009; Loop until all commands printed
X 40$:`009MOVL`009#SS$_NORMAL,R0`009`009; Set return code
X`009RET`009`009`009`009; Return to caller
X`009`009`009`009`009;
X;===========================================================================
V====
X;   Subroutine FLUSH_CMDS - Flush the DCL command RECALL buffer
X;
X`009.ENTRY`009FLUSH_CMDS,`094M<>
X`009CALLS`009#0,GETPRV`009`009; Turn on the CMEXEC to do this
X`009BLBC`009R0,10$`009`009`009; If error (No priv), return
X`009$CMEXEC_S -`009`009`009; Flush the DCL command buffer
X`009`009ROUTIN=EXEC_FLUSH`009; ...  (zero it out)
X 10$:`009RET`009`009`009`009; Return to caller
X;
X;  Zero out the DCL command recall buffer
X;
X`009.ENTRY`009EXEC_FLUSH,`094M<R2,R3,R4,R5>
X`009MOVAB`009G`094CTL$AG_CLIDATA,R3`009`009; Get address of CLI data
X`009MOVL`009PPD$L_PRC(R3),R3`009`009; Get address of PRC region
X`009MOVAB`009PRC_G_COMMANDS(R3),-`009`009; Reset last command pointer
X`009`009PRC_L_RECALLPTR(R3)`009`009; ...
X`009MOVC5`009#0,#0,#0,#PRC_S_COMMANDS,-`009; Zero out the DCL command
X`009`009PRC_G_COMMANDS(R3)`009`009; ...  recall buffer
X`009MOVL`009#SS$_NORMAL,R0`009`009`009; Set return status
X`009RET`009`009`009`009`009; Return to caller
X`009`009`009`009`009`009;
X;===========================================================================
V====
X;   Subroutine GETPRV - Turn on either CMEXEC or CMKRNL to do FLUSH and REST
VORE
X;
X`009.ENTRY`009GETPRV,`094M<>
X`009$SETPRV_S -`009`009`009; Turn on CMEXEC privilege
X`009`009ENBFLG=#1, -`009`009; ...
X`009`009PRVADR=CMEXEC`009`009; ...
X`009CMPL`009#SS$_NORMAL,R0`009`009; Was CMEXEC turned on?
X`009BEQLU`00910$`009`009`009; Yes - return
X`009$SETPRV_S -`009`009`009; If not, try to turn on CMKRNL
X`009`009ENBFLG=#1, -`009`009; ...
X`009`009PRVADR=CMKRNL`009`009; ...
X`009CMPL`009#SS$_NORMAL,R0`009`009; Was CMEXEC turned on?
X`009BEQLU`00910$`009`009`009; Yes - return
X`009MOVL`009#SS$_NOCMEXEC,R0`009; If not, tell that CMEXEC is needed
X 10$:`009RET`009`009`009`009; Return to caller
X
X`009.END`009DCL_CMDS
$ CALL UNPACK CMD.MAR;1 557104931
$ create/nolog 'f'
X;===============   DCLKEYMACS.MAR
X;
X; AUTHOR:`009Hunter Goatley
X;`009`009Clyde Digital Systems
X;`009`009371 East 800 South
X;`009`009Orem, Utah  84058
X;`009`009(801) 224-5306
X;`009`009CREATION DATE:`00915-MAY-1987
X
X;
X;  CHECK_ARGS`009- Checks the number of arguments passed to a routine.
X;`009`009  If an invalid number of arguments are given, control
X;`009`009  returns to the user with LIB$_WRONUMARG status.
X;
X`009.MACRO`009CHECK_ARGS`009NUMBER,?LABEL
X`009MOVL`009#LIB$_WRONUMARG,R0`009; Assume error
X`009CMPW`009NUMBER,(AP)`009`009; Were there enough?
X`009BEQLU`009LABEL`009`009`009; Yes - no sweat
X`009RET`009`009`009`009; No - return with error
XLABEL:`009.ENDM`009CHECK_ARGS
X
X;
X;  GET_PRC`009- Places the PRC address in R11.
X;
X`009.MACRO`009GET_PRC
X`009MOVAL`009G`094CTL$AG_CLIDATA,R11`009; Get address of CLI data
X`009MOVL`009PPD$L_PRC(R11),R11`009; Get address of PRoCess data region
X`009.ENDM`009GET_PRC
X
X
X;================  DEFINE.MAR
X`009.TITLE`009HG$DEFINE_KEY
X`009.IDENT`009"01-001"
X;+
X;  Function:`009HG$DEFINE_KEY
X;
X;  Author:`009Hunter Goatley   15-MAY-1987
X;
X;  Functional description:
X;
X;`009HG$DEFINE_KEY performs the same function as the DCL DEFINE/KEY command.
X;
X;  Inputs:
X;
X;`0094(AP)`009- Descriptor pointing to the keyname to define
X;`0098(AP)`009- Descriptor pointing to the key's value
X;`00912(AP)`009- Descriptor pointing to /IF_STATE= string
X;`00916(AP)`009- Descriptor pointing to /SET_STATE string (0
X;`009   `009  if the key does not SET_STATE)
X;`00920(AP)`009- Address of longword holding SYM_M_* flags
X;
X;  Outputs:
X;
X;`009Status in R0`009- SS$_NORMAL, LIB$_INSCLIMEM
X;
X;  Effects:
X;
X;`009Defines a DCL key
X;
X;  Calling sequence:
X;
X;    STATUS = HG$DEFINE_KEY ("PF1","SHOW USERS","DEFAULT",,(SYM_M_ECHO) BY R
VEF)
X;-
XVMS4_5 = 1`009;**************************** Remove this line if under VMS 4.
V1
X
X`009.LIBRARY`009/DCL$KEYLIB:DCLKEY.MLB/
X`009.LINK`009`009/SYS$SYSTEM:SYS.STB/
X`009.LINK`009`009/SYS$SYSTEM:DCLDEF.STB/
X
X`009.PSECT`009_HG$DEFINE_KEY_CODE,EXE,NOWRT,LONG,PIC,SHR
XKEY_NAME`009= 4
XEQUIVALENCE`009= 8
XIF_STATE`009= 12
XSET_STATE`009= 16
XFLAGS`009`009= 20
XWORK_BYTES`009= 512
X`009.ENTRY`009HG$DEFINE_KEY,`094M<R3,R10,R11>
X`009CHECK_ARGS`009#5`009`009; Make sure 5 arguments are present
X`009SUBL2`009#WORK_BYTES,SP`009`009; Allocate some space on the stack
X`009MOVL`009SP,R10`009`009`009; R10 --> template
X;
X;  Fill in the key template
X;
X`009CLRL`009SYM_L_FL(R10)`009`009; Clear forward link
X`009CLRL`009SYM_L_BL(R10)`009`009; Clear backward link
X
X.IF DEFINED VMS4_5
X`009CLRL`009SYM_L_ORDERED(R10)`009; Clear ORDERED link (not used)
X`009CLRW`009SYM_W_FILELEVEL(R10)`009; Clear file level
X`009MNEGW`009#1,SYM_W_PROCLEVEL(R10)`009; Set no procedure level
X`009CLRL`009SYM_L_PROCSEQ(R10)`009; ...
X`009CLRW`009SYM_W_BLOCKLEVEL(R10)`009; ...
X`009CLRL`009SYM_L_BLOCKSEQ(R10)`009; ...
X.ENDC
X`009CLRW`009SYM_W_SIZE(R10)`009`009; Clear size
X`009MOVB`009#SYM_K_KEYPAD, -`009; Set symbol entry type (KEYPAD symbol)
X`009`009SYM_B_TYPE(R10)`009`009; ...
X`009MOVL`009FLAGS(AP),R0`009`009; Get the flags
X.IF DEFINED VMS4_5
X`009MOVW`009(R0),SYM_W_FLAGS(R10)`009; ...  and set them in the template
X.IF_FALSE
X`009MOVB`009(R0),SYM_B_FLAGS(R10)`009; ...  and set them in the template
X.ENDC
X`009MOVAB`009SYM_T_SYMBOL(R10),R3`009; Get address in template of key name
X`009MOVL`009KEY_NAME(AP),R0`009`009; Get the key name
X`009MOVB`009(R0),(R3)+`009`009; Move its length
X`009MOVC3`009(R0),@4(R0),(R3)`009; Copy the string to the template
X`009MOVW`009@IF_STATE(AP),R0`009; Get sum of lengths of next 3 strings
X`009ADDW2`009@EQUIVALENCE(AP),R0`009; ...
X`009TSTL`009SET_STATE(AP)`009`009; Was a SET_STATE name given?
X`009BEQLU`00910$`009`009`009; No - don't try to move the length
X`009ADDW2`009@SET_STATE(AP),R0`009; ...
X10$:`009ADDW2`009#4,R0`009`009`009; ...  + 4 (the number of length bytes)
X`009MOVW`009R0,(R3)+`009`009; Put sum of lengths of next 3 fields
X`009PUSHL`009R0`009`009`009; Save the length for a minute
X`009MOVL`009IF_STATE(AP),R1`009`009; Get address of IF_STATE
X`009MOVB`009(R1),(R3)+`009`009; Move length of IF_STATE
X`009MOVC3`009(R1),@4(R1),(R3)`009; Move IF_STATE string
X`009MOVL`009EQUIVALENCE(AP),R1`009; Get address of EQUIVALENCE string
X`009MOVW`009(R1),(R3)+`009`009; Move length of EQUIVALENCE
X`009MOVC3`009(R1),@4(R1),(R3)`009; Move EQUIVALENCE string
X`009MOVL`009SET_STATE(AP),R1`009; Get address of SET_STATE
X`009BEQLU`00920$`009`009`009; If the address is 0, no SET_STATE
X`009MOVB`009(R1),(R3)+`009`009; Move length of SET_STATE
X`009MOVC3`009(R1),@4(R1),(R3)`009; Move SET_STATE string
X.IF DEFINED VMS4_5
X`009BISW2`009#SYM_M_STATE, -`009`009; Set STATE bit in FLAGS (just in case
X`009`009SYM_W_FLAGS(R10)`009; ...  the caller did not set it)
X.IF_FALSE
X`009BISB2`009#SYM_M_STATE, -`009`009; Set STATE bit in FLAGS (just in case
X`009`009SYM_B_FLAGS(R10)`009; ...  the caller did not set it)
X.ENDC
X20$:`009CLRB`009(R3)+`009`009`009; Clear last byte of template (could be
X`009`009`009`009`009; ...  taken as length of SET_STATE)
X`009ADDL3`009(SP)+,#SYM_T_SYMBOL+1,R0 ; Calculate the size of the template
X`009ADDB2`009SYM_T_SYMBOL(R10),R0`009; ...
X`009ADDL2`009#2,R0`009`009`009; Include word sum of the 3 lengths
X`009ADDL2`009#7,R0`009`009`009; Truncate to a quadword boundary
X`009BICL2`009#7,R0`009`009`009; Round to next quadword boundary
X`009MOVW`009R0,SYM_W_SIZE(R10)`009; Set the size of the queue entry
X`009$CMEXEC_S -`009`009`009; Go to executive mode to define key
X`009`009ROUTIN=EXEC_KEYDEF`009; ...
X`009ADDL2`009#WORK_BYTES,SP`009`009; Clean up the stack
X`009RET
X;
X;  Executive mode routine to allocate CLI memory and insert the new key
X;  definition into the KEYPAD queue.
X;
X`009.ENTRY`009EXEC_KEYDEF,`094M<R3,R11>
X`009GET_PRC`009`009`009`009`009; Get address or PRoCess data
X`009MOVAB`009PRC_Q_ALLOCREG(R11),R3`009`009; Addr of free memory
X`009MOVZWL`009SYM_W_SIZE(R10),R1`009`009; Get size of block to allocate
X`009JSB`009@#EXE$ALLOCATE`009`009`009; Allocate some CLI memory
X`009MOVL`009#LIB$_INSCLIMEM,R0`009`009; Assume not enough CLI memory
X`009TSTL`009R2`009`009`009`009; Was there space allocated?
X`009BEQL`00920$`009`009`009`009; No - return the error
X`009PUSHR`009#`094M<R0,R1,R2,R3,R4,R5>`009`009; Copy the key definition from
X`009MOVC5`009SYM_W_SIZE(R10),(R10),#0, -`009; ...  the template on the
X`009`009R1,(R2)`009`009`009`009; ...  stack to the memory just
X`009POPR`009#`094M<R0,R1,R2,R3,R4,R5>`009`009; ...  allocated
X`009MOVW`009R1,SYM_W_SIZE(R10)`009`009; Set actual length allocated
X`009BSBW`009FIND_PLACE`009`009`009; Find the queue position for
X`009`009`009`009`009`009; ...  the key definition
X`009INSQUE`009SYM_L_FL(R2),@SYM_L_BL(R0)`009; Insert key def into queue at
X`009`009`009`009`009`009; ...  position returned in R0
X`009`009`009`009`009`009; ...  (by FIND_PLACE)
X`009MOVL`009#SS$_NORMAL,R0`009`009`009; Set successful return status
X20$:`009RET`009`009`009`009`009; Return to caller
X
X;+
X;  For efficiency and special-processing, internal subroutines were used
X;  to find the queue position and delete an existing key definition (instead
X;  of using the CALLable routines HG$FIND_KEY and HG$DELETE_KEY).
X;-
XFIND_PLACE:
X`009PUSHR`009#`094M<R1,R2,R3,R4,R5,R6,R7,R8,R9>`009; Save registers needed
X`009MOVAB`009SYM_T_SYMBOL+1(R10),R1`009`009; Get addr of key name
X`009MOVZBL`009-1(R1),R0`009`009`009; Get its length
X`009ADDL2`009R0,R1`009`009`009`009; R1 --> word length of rest
X`009INCL`009R1`009`009`009`009; Bump R1 over the word length
X `009INCL`009R1`009`009`009`009; R1 --> IF_STATE string
X`009MOVZBL`009(R1)+,R0`009`009`009; Get the IF_STATE length
X`009PUSHL`009R1`009`009`009`009; Put addr on the stack
X`009PUSHL`009R0`009`009`009`009; Put the length on the stack
X`009MOVZBL`009SYM_T_SYMBOL(R10),R8`009`009; R8 = length of key name
X`009MOVAB`009SYM_T_SYMBOL+1(R10),R9`009`009; R9 --> key name
X`009MOVL`009PRC_Q_KEYPAD(R11),R6`009`009; R6 --> first entry in queue
X`009MOVAB`009PRC_Q_KEYPAD(R11),R7`009`009; R7 --> beginning of queue
X10$:`009CMPL`009R6,R7`009`009`009`009; Reached end of queue?
X`009BEQLU`00920$`009`009`009`009; Yes - found place
X`009`009`009`009`009`009; Check the state name
X`009MOVAB`009SYM_T_SYMBOL+1(R6),R1`009`009; Get addr of key name
X`009MOVZBL`009-1(R1),R0`009`009`009; Get its length
X`009ADDL2`009R0,R1`009`009`009`009; R1 --> word length of rest
X`009INCL`009R1`009`009`009`009; Bump R1 over the word length
X`009INCL`009R1`009`009`009`009; R1 --> IF_STATE string
X`009MOVZBL`009(R1)+,R0`009`009`009; Get the IF_STATE length
X`009CMPC5`009(SP),@4(SP),#`094A/ /,R0,(R1)`009; Is this the same state?
X`009BLSSU`00920$`009`009`009`009; No - try next entry
X `009BGTRU`00915$`009`009`009`009; If >, no entries for IF_STATE
X`009`009`009`009`009`009; Check the key names
X`009MOVZBL`009SYM_T_SYMBOL(R6),R0`009`009; Get length of key name in que
X`009CMPC5`009R8,(R9),#`094A/ /,R0,SYM_T_SYMBOL+1(R6)`009; Compare the string
Vs
X`009BLSSU`00920$`009`009`009`009; Found place if KEY < QUEUE KEY
X`009BNEQU`00915$`009`009`009`009; If not the same, go try next
X;
X; Here if key already exists
X;
X`009BSBW`009DELETEKEY`009`009`009; Delete the key
X`009BRB`00920$`009`009`009`009; Return to caller
X15$:`009MOVL`009SYM_L_FL(R6),R6`009`009`009; Get the next keypad entry
X`009BRB`00910$`009`009`009`009; ...  and try again
X20$:`009ADDL2`009#8,SP`009     `009`009`009; Clean up stack
X`009MOVL`009R6,R0`009`009`009`009; Return addr of QUEUE KEY entry
X`009POPR`009#`094M<R1,R2,R3,R4,R5,R6,R7,R8,R9>`009; ...
X`009RSB`009`009`009`009`009; ...
X
XDELETEKEY:
X`009PUSHL`009R3`009`009`009`009; Save work register
X`009MOVAB`009PRC_Q_ALLOCREG(R11),R3`009`009; Get allocation region listhead
X`009REMQUE`009SYM_L_FL(R6),R0`009`009`009; Remove key def from the queue
X`009MOVL`009SYM_L_FL(R0),R6`009`009`009; Make the Forward Link entry
X`009`009`009`009`009`009; ... new "current" entry
X`009MOVZWL`009SYM_W_SIZE(R0),R1`009`009; Get deleted entry size
X`009JSB`009@#EXE$DEALLOCATE`009`009; Deallocate the memory
X`009MOVL`009(SP)+,R3`009`009`009; Restore register
X`009RSB`009`009`009`009`009; Return to caller
X
X`009.END
X
X;================  DELETE.MAR
X`009.TITLE`009HG$DELETE_KEY
X`009.IDENT`009"01-001"
X;+
X;  Function:`009HG$DELETE_KEY
X;
X;  Author:`009Hunter Goatley   15-MAY-1987
X;
X;  Functional description:
X;
X;`009HG$DELETE_KEY performs the same function as the DCL DELETE/KEY command.
X;
X;  Inputs:
X;
X;`0094(AP)`009- Descriptor pointing to the keyname to delete
X;`0098(AP)`009- Descriptor pointing to /STATE string
X;
X;  Outputs:
X;
X;`009Status in R0`009- SS$_NORMAL, LIB$_NOTFOU
X;
X;  Effects:
X;
X;`009Deletes DCL key definition
X;
X;  Calling sequence:
X;
X;    STATUS = HG$DELETE_KEY ("PF1","DEFAULT")
X;-
X
X`009.LIBRARY`009/DCL$KEYLIB:DCLKEY.MLB/
X`009.LINK`009`009/SYS$SYSTEM:DCLDEF.STB/
X`009.LINK`009`009/SYS$SYSTEM:SYS.STB/
X
X`009.PSECT`009_HG$DELETE_KEY_CODE,EXE,NOWRT,PIC,SHR
XKEY`009= 4
XSTATE`009= 8
X`009.ENTRY`009HG$DELETE_KEY,`094M<>
X`009CHECK_ARGS`009#2`009`009`009; Check # of arguments
X`009$CMEXEC_S -`009`009`009`009; Need to be in EXEC mode
X`009`009ROUTIN=EXEC_DELETE_KEY, -`009; ...
X`009`009ARGLST=(AP)`009`009`009; ...
X`009RET`009`009`009`009`009; Return to caller
X
X`009.ENTRY`009EXEC_DELETE_KEY,`094M<R2,R3,R6>
X`009GET_PRC`009`009`009`009`009; Get the PRC address
X`009MOVAL`009-(SP),R6`009`009`009; Get some stack space
X`009PUSHAL`009(R6)`009`009`009`009; Longword to receive address
X`009PUSHL`009STATE(AP)`009`009`009; Push state descriptor address
X`009PUSHL`009KEY(AP)`009`009`009`009; Push key descriptor address
X`009CALLS`009#3,G`094HG$FIND_KEY`009       `009; Find the key's queue addres
Vs
X`009BLBC`009R0,100$`009`009`009    `009; Error?  Exit with error
X;
X;  Here if (R6) has valid keypad entry address
X;
X`009MOVL`009(R6),R6`009`009`009`009; Get address of entry
X`009REMQUE`009SYM_L_FL(R6),R0`009`009`009; Remove the keypad entry from
X`009`009`009`009`009`009; ...  the keypad queue
X`009MOVZWL`009SYM_W_SIZE(R0),R1`009`009; Get the size of the block
X`009MOVAB`009PRC_Q_ALLOCREG(R11),R3`009`009; Get allocation region listhead
X`009JSB`009@#EXE$DEALLOCATE`009`009; Deallocate the block
X`009MOVL`009#SS$_NORMAL,R0`009`009`009; Set successful return status
X100$:`009TSTL`009(SP)+`009`009`009`009; Reset stack pointer
X`009RET`009`009`009`009`009; Return to caller
X
X`009.END
X
X;================  FIND.MAR
X`009.TITLE`009HG$FIND_KEY
X`009.IDENT`009"01-001"
X;+
X;  Function:`009HG$FIND_KEY
X;
X;  Author:`009Hunter Goatley   15-MAY-1987
X;
X;  Functional description:
X;
X;`009HG$FIND_KEY returns the address of a key definition if it exists.
X;`009If there is no matching definition, the address of the predecessor
X;`009is returned.
X;
X;  Environment:
X;
X;`009EXECutive mode
X;
X;  Inputs:
X;
X;`0094(AP)`009- Descriptor pointing to the keyname to define
X;`0098(AP)`009- Descriptor pointing to /IF_STATE= string
X;
X;  Returns:
X;
X;`009R0 = SS$_NORMAL if key was found (Address in 12(AP))
X;`009R0 = LIB$_NOTFOU if key was not found (Predecessor address in 12(AP))
X;
X;  Effects:
X;
X;`009None.
X;
X;  Calling sequence:
X;
X;    STATUS = HG$FIND_KEY ("PF1","DEFAULT", ADDRESS%)
X;-
X
X`009.LIBRARY`009/DCL$KEYLIB:DCLKEY.MLB/
X
X`009$SSDEF
X`009$LIBDEF
X
X`009.PSECT`009HG$FIND_KEY,EXE,NOWRT,SHR,PIC
XKEY`009= 4
XIF_STATE = 8
XADDR`009= 12
X`009.ENTRY`009HG$FIND_KEY,`094M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
X`009CHECK_ARGS`009#3
X`009GET_PRC`009`009`009`009`009; Get the PRC address
X`009MOVQ`009@KEY(AP),R8`009`009`009; Get key name descriptor
X`009MOVQ`009@IF_STATE(AP),-(SP)`009`009; Get IF_STATE descriptor
X`009MOVL`009ADDR(AP),R10`009`009`009; Longword to return addr in
X`009MOVL`009PRC_Q_KEYPAD(R11),R6`009`009; Get keypad queue listhead
X`009MOVAB`009PRC_Q_KEYPAD(R11),R7`009`009; Get address of queue listhead
X;
X;  Loop through all keypad entries until the correct entry is found.
X;
X10$:`009MOVL`009R6,(R10)`009`009`009; Move PREDECESSOR address
X`009CMPL`009R6,R7`009`009`009`009; Have we reached the end?
X`009BEQLU`009100$`009`009`009`009; ... (Current entry = listhead)
X`009MOVAB`009SYM_T_SYMBOL(R6),R1`009`009; Addr of entry's KEY name
X`009MOVZBL`009(R1)+,R0`009`009`009; Get length of KEY name
X`009ADDL2`009R0,R1`009`009`009`009; R1 --> word length of rest
X`009TSTW`009(R1)+`009`009`009`009; Bump over the word length
X`009MOVZBL`009(R1)+,R0`009`009`009; R0 = length of IF_STATE name
X`009`009`009`009`009`009; R1 -> IF_STATE name
X`009CMPC5`009(SP),@4(SP),#`094A/ /,R0,(R1)`009; Is the state = given state?
X`009BLSSU`009100$`009`009`009`009; If <, no entries for given state
X`009BGTRU`00920$`009`009`009`009; If >, go check next keypad entry
X;
X;  Here if we have a match on the IF_STATE
X;
X`009MOVZBL`009SYM_T_SYMBOL(R6),R0`009`009; R0 = len of entry's KEY name
X`009CMPC5`009R8,(R9),#`094A/ /,R0,SYM_T_SYMBOL+1(R6)`009; Right entry?
X`009BLSSU`009100$`009`009`009`009; If <, found predecessor
X`009BNEQU`00920$`009`009`009`009; If <>, try next entry
X;
X;  Here if we found the target keypad entry
X;
X`009MOVL`009#SS$_NORMAL,R0`009`009`009; Set return status
X`009BRB`009110$`009`009`009`009; ... and go return to caller
X20$:`009MOVL`009SYM_L_FL(R6),R6`009`009`009; Get addr of next keypad entry
X`009BRB`00910$`009`009`009`009; ... and check it out
X100$:`009MOVL`009#LIB$_NOTFOU,R0`009`009`009; Return "Not found" status
X110$:`009ADDL2`009#8,SP`009`009`009`009; Reset stack pointer
X`009RET`009`009`009`009`009; Return to caller
X
X`009.END
X
X
X;================  GETDEF.MAR
X`009.TITLE`009HG$GET_KEYDEF
X`009.IDENT`009"01-001"
X;+
X;  Function:`009HG$GET_KEYDEF
X;
X;  Author:`009Hunter Goatley   15-MAY-1987
X;
X;  Functional description:
X;
X;`009HG$GET_KEYDEF returns the definition of a DCL key.
X;
X;  Inputs:
X;
X;`0094(AP)`009- Descriptor pointing to the keyname to return info about
X;`0098(AP)`009- Descriptor pointing to the state name
X;`00912(AP)`009- Descriptor pointing to buffer to receive equivalence string
X;`00916(AP)`009- Address of a word to receive the definition flags
X;`00920(AP)`009- Descriptor pointing to buffer to receive /SET_STATE string
V (0
X;`009   `009  if the key does not SET_STATE)
X;
X;  Outputs:
X;
X;`009Status in R0`009- SS$_NORMAL, LIB$_NOTFOU
X;
X;  Calling sequence:
X;
X;    STATUS = HG$GET_KEYDEF ("PF1","DEFAULT",EQUIV$, FLAGS%, SETSTATE$)
X;-
XVMS4_5 = 1`009;**************************** Remove this line if under VMS 4.
V1
X
X`009.LIBRARY`009/DCL$KEYLIB:DCLKEY.MLB/
X`009.LINK`009`009/SYS$SYSTEM:SYS.STB/
X`009.LINK`009`009/SYS$SYSTEM:DCLDEF.STB/
X
X`009.PSECT`009_HG$GET_KEYDEF_CODE,EXE,NOWRT,PIC,SHR
XKEY`009= 4
XSTATE`009= 8
XEQUIV`009= 12
XFLAGS`009= 16
XSET_STATE = 20
X`009.ENTRY`009HG$GET_KEYDEF,`094M<>
X`009CHECK_ARGS`009#5`009`009`009; Check # of arguments
X`009$CMEXEC_S -`009`009`009`009; Need to be in EXEC mode
X`009`009ROUTIN=EXEC_GET_KEYDEF, -`009; ...
X`009`009ARGLST=(AP)`009`009`009; ...
X`009RET
X
X`009.ENTRY`009EXEC_GET_KEYDEF,`094M<R6>
X`009GET_PRC`009`009`009`009`009; Get the PRC address
X`009MOVAL`009-(SP),R6`009`009`009; Get some stack space
X`009PUSHAL`009(R6)`009`009`009`009; Longword to receive address
X`009PUSHL`009STATE(AP)`009`009`009; Push state descriptor address
X`009PUSHL`009KEY(AP)`009`009`009`009; Push key descriptor address
X`009CALLS`009#3,G`094HG$FIND_KEY`009`009; Find the key's queue address
X`009BLBC`009R0,100$`009`009`009`009; Error?  Exit with error
X;
X;  Here if (R6) has valid keypad entry address
X;
X`009MOVL`009(R6),R6`009`009`009`009; Get address of entry
X.IF DEFINED VMS4_5
X`009MOVW`009SYM_W_FLAGS(R6),@FLAGS(AP)`009; Copy flags to user's buffer
X.IF_FALSE
X`009MOVZBW`009SYM_B_FLAGS(R6),@FLAGS(AP)`009; Copy flags to user's buffer
X.ENDC
X`009MOVAB`009SYM_T_SYMBOL(R6),R6`009`009; R6 -> symbol name
X`009MOVZBL`009(R6)+,R0`009`009`009; Get length of key name
X`009ADDL2`009R0,R6`009`009`009`009; Bump R6 over key name
X`009TSTW`009(R6)+`009`009`009`009; Bump R6 over word length
X`009MOVZBL`009(R6)+,R0`009`009`009; R0 = length of IF_STATE name
X`009ADDL2`009R0,R6`009`009`009`009; R6 -> ASCIC equivalence string
X`009MOVZWL`009(R6)+,R0`009`009`009; R0 = length of equiv. str.
X`009`009`009`009      `009`009; R6 -> equivalence string
X`009PUSHL`009R0`009`009`009`009; ...  onto the stack
X`009MOVL`009SP,R0`009`009`009`009; ...  and get their address
X`009PUSHL`009R6`009`009`009`009; Push the length and address
X`009PUSHAL`009(R0)`009`009`009`009; ...  buffer
X`009PUSHL`009EQUIV(AP)`009`009`009; ...
X`009CALLS`009#3,G`094STR$COPY_R`009`009`009; ...
X`009ADDL2`009(SP)+,R6`009`009`009; R6 --> ASCIC SET_STATE string
X`009MOVZBL`009(R6)+,-(SP)`009`009`009; SP --> length
X`009MOVL`009SP,R0`009`009`009`009; Get address of length
X`009PUSHL`009R6`009`009`009`009; Push the length and address
X`009PUSHAL`009(R0)`009`009`009`009; ...  buffer
X`009PUSHL`009SET_STATE(AP)`009`009`009; ...
X`009CALLS`009#3,G`094STR$COPY_R`009`009`009; ...
X100$:`009RET`009`009`009`009`009; Return to caller
X
X`009.END
X
X
X;================  STATE.MAR
X`009.TITLE`009HG$SET_KEYSTATE
X`009.IDENT`009"01-001"
X;+
X;  Function:`009HG$SET_KEYSTATE
X;
X;  Author:`009Hunter Goatley   15-MAY-1987
X;
X;  Functional description:
X;
X;`009HG$SET_KEYSTATE performs the same function as the DCL SET KEY/STATE=
X;`009command.
X;
X;  Inputs:
X;
X;`0094(AP)`009- Descriptor pointing to the new key state name
X;`0098(AP)`009- Address of word to receive length of string returned
X;`009`009  (0 if not desired)
X;`00912(AP)`009- Descriptor pointing to buffer to receive old key state
X;`009`009  (0 if not desired)
X;
X;  Outputs:
X;
X;`009Status in R0`009- SS$_NORMAL, codes returned by STR$COPY_R
X;
X;  Effects:
X;
X;`009Sets and returns DCL Key State
X;
X;  Calling sequence:
X;
X;    STATUS = HG$SET_KEYSTATE ("SETDEF", LENGTH%, OLDSTATE$)
X;-
X
X`009.LIBRARY`009/DCL$KEYLIB:DCLKEY.MLB/
X`009.LINK`009`009/SYS$SYSTEM:SYS.STB/
X`009.LINK`009`009/SYS$SYSTEM:DCLDEF.STB/
X
X`009.PSECT`009_HG$SET_KEYSTATE_CODE,EXE,NOWRT,PIC,SHR
XNEWSTATE`009= 4
XOLDLEN`009`009= 8
XOLDSTATE`009= 12
X`009.ENTRY`009HG$SET_KEYSTATE,`094M<>
X`009CHECK_ARGS`009#3`009`009`009; Were enough arguments given?
X10$:`009$CMEXEC_S -`009`009`009`009; Need to be in EXEC mode
X`009`009ROUTIN=EXEC_SET_KEYSTATE, -`009; ...
X`009`009ARGLST=(AP)`009`009`009; ...
X`009RET`009`009`009`009`009; Return to caller
X
X`009.ENTRY`009EXEC_SET_KEYSTATE,`094M<R2,R3,R4,R5,R6,R7,R11>
X`009GET_PRC`009`009`009`009`009; Get the PRC adtress
X`009MOVL`009PRC_L_CURRKEY(R11),R6`009`009; Get address of key state
X`009TSTL`009OLDSTATE(AP)`009`009`009; Did user want old state name?
X`009BEQLU`00910$`009`009`009`009; No - skip it
X`009MOVZBL`009(R6),R0`009`009`009`009; Get the length of the state
X`009PUSHL`009R0`009`009`009`009; Push the length
X`009MOVL`009SP,R0`009`009`009`009; Get the address of the length
X`009PUSHL`009R6`009`009`009`009; Push the string address
X`009INCL`009(SP)`009`009`009`009; Bump it past the length
X`009PUSHAL`009(R0)`009`009`009`009; Push address of length
X`009PUSHL`009OLDSTATE(AP)`009`009`009; Push return desc. address
X`009CALLS`009#3,G`094STR$COPY_R`009`009`009; Copy the string to the buffer
X`009POPL`009R1`009`009`009`009; Remove the old length
X`009BLBC`009R0,100$`009`009`009`009; Error?  Return if so
X10$:`009TSTL`009OLDLEN(AP)`009`009`009; Did user want return length?
X`009BEQLU`00920$`009`009`009`009; No - skip it
X`009MOVZBW`009(R6),@OLDLEN(AP)`009`009; Move the length
X20$:`009TSTL`009NEWSTATE(AP)`009`009`009; Did user give new state?
X`009BEQLU`00990$`009`009`009`009; No - skip it
X; R6 --> current key state
X`009MOVQ`009@NEWSTATE(AP),R4`009`009; Get new state descriptor
X`009MOVZWL`009R4,R1`009`009`009`009; Move size to R1
X`009INCL`009R1`009`009`009`009; Bump to include count byte
X`009BSBB`009ALLOSTATE`009`009`009; Get some new memory
X`009MOVL`009R2,PRC_L_CURRKEY(R11)`009`009; Set new state address
X`009MOVB`009R4,(R2)+`009`009`009; Set the new state length
X`009MOVC3`009R4,(R5),(R2)`009`009`009; Set the new keypad state
X`009BSBB`009DEALSTATE`009`009`009; Deallocate the old state
X`009MOVL`009PRC_L_CURRKEY(R11), -`009`009; Copy the key state address
X`009`009PRC_L_LASTKEY(R11)`009`009; ...  to PRC_L_LASTKEY
X90$:`009MOVL`009#SS$_NORMAL,R0`009`009`009; Set return status
X100$:`009RET
X
XDEALSTATE:
X`009PUSHR`009#`094M<R0,R1,R3>`009`009; Save work registers
X`009MOVAB`009PRC_Q_ALLOCREG(R11),R3`009; Get allocation region listhead
X`009MOVL`009R6,R0`009`009`009; Get address
X`009MOVZBL`009(R0),R1`009`009`009; Get deleted entry size
X`009INCL`009R1`009`009`009; Bump to include length byte
X`009ADDL2`009#7,R1`009`009`009; Truncate to a quadword boundary
X`009BICL2`009#7,R1`009`009`009; Round to next quadword boundary
X`009JSB`009@#EXE$DEALLOCATE`009; Deallocate the memory
X`009POPR`009#`094M<R0,R1,R3>`009`009; Restore work registers
X`009RSB`009`009`009`009; Return to caller
X
XALLOSTATE:
X`009PUSHR`009#`094M<R0,R1,R3>`009`009; Save work registers
X`009MOVAB`009PRC_Q_ALLOCREG(R11),R3`009; Get allocation region listhead
X`009ADDL2`009#7,R1`009`009`009; Truncate to a quadword boundary
X`009BICL2`009#7,R1`009`009`009; Round to next quadword boundary
X`009JSB`009@#EXE$ALLOCATE`009`009; Deallocate the memory
X`009POPR`009#`094M<R0,R1,R3>`009`009; Restore work registers
X`009RSB`009`009`009`009; Return to caller
X
X`009.END
$ CALL UNPACK DCLKEYS.MAR;1 973664127
$ create/nolog 'f'
X`009.TITLE`009HG$GET_INPUT
X`009.IDENT`009/01-001/
X;++
X;
X;  Routine:`009HG$GET_INPUT
X;
X;  Author:`009Hunter Goatley
X;`009`009Clyde Digital Systems
X;`009`009371 East 800 South
X;`009`009Orem, Utah  84058
X;`009`009801-224-5306
X;
X;  Date:`009July 11, 1988
X;
X;  Functional Description:
X;
X;`009This  routine implements an easy-to-call interface to the SMG$
X;`009routines  to  provide  command  recall   when   reading   from
X;`009SYS$INPUT.   It  takes the same arguments as LIB$GET_INPUT and
X;`009may be substituted directly in any call to LIB$GET_INPUT.`032
X;
X;`009Example:
X;
X;`009`009CALL LIB$GET_INPUT (buffer, prompt, buffer)
X;`009`009`009to
X;`009`009CALL HG$GET_INPUT (buffer, prompt, buffer)
X;
X;  To assemble and use:
X;
X;`009$ MACRO HG$GET_INPUT
X;`009$ LINK  your_program,HG$GET_INPUT
X;`009$ RUN   your_program
X;
X;  Modified by:
X;
X;`00901-001`009`009Hunter Goatley`009`00911-JUL-1988 21:28
X;`009`009Original version.
X;
X;--
X
X;+
X;
X;`009HG$GET_INPUT  get-str `091,prompt-str`093 `091,out-len`093
X;
X;  Inputs:
X;
X;`0094(AP)`009- String which is read from SYS$INPUT.
X;`009`009  Address of string descriptor.   Write-only.
X;`0098(AP)`009- Prompt message that is displayed (optional).
X;`009`009  Address of string descriptor.  Read-only.
X;`00912(AP)`009- Number of bytes written into @4(AP) (optional).
X;`009`009  Address of word.  Write-only.
X;
X;  Returns:
X;
X;`009String in 4(AP) and status in R0.
X;
X;  Effects:
X;
X;`009On first call, a key table and a virtual keyboard are created.
X;
X;-
X
XBUFFER`009= 1 * 4`009`009`009`009`009; 1st arg is receiving buffer
XPROMPT`009= 2 * 4`009`009`009`009`009; 2nd arg is prompt
XRETLEN`009= 3 * 4`009`009`009`009`009; 3rd arg is receiving length
X
X`009$RMSDEF`009`009`009`009`009; Include RMS symbols
X`009$SSDEF`009`009`009`009`009; System service status symbols
X`009$SMGDEF`009`009`009`009`009; Include SMG$ symbols
X
X`009.PSECT`009_HG$GET_INPUT_DATA,NOEXE,WRT,LONG
X
XKEY_TABLE_ID::`009.LONG`0090`009`009`009; ID of key table created
XKEYBOARD_ID::`009.LONG`0090`009`009`009; ID of virtual keyboard created
X
X`009.PSECT`009_HG$GET_INPUT_CODE,EXE,NOWRT,LONG,PIC,SHR
X
X`009.ENTRY`009HG$GET_INPUT,`094M<>
X
X`009TSTL`009KEY_TABLE_ID`009`009`009; Have we been called yet?
X`009`009`009`009`009`009; ... (KEY_TABLE_ID <> 0)
X`009BNEQU`00910$`009`009`009`009; Yes - skip initialization
X`009PUSHAL`009KEY_TABLE_ID`009`009`009; Create a key table by
X`009CALLS`009#1,G`094SMG$CREATE_KEY_TABLE`009; ...  calling SMG$ routine
X`009BLBC`009R0,40$`009`009`009`009; Return on error
X`009PUSHAL`009KEYBOARD_ID`009`009`009; Create a virtual keyboard
X`009CALLS`009#1,G`094SMG$CREATE_VIRTUAL_KEYBOARD
X`009BLBC`009R0,40$`009`009`009`009; Return on error
X;
X;  Pass our parameters on to SMG$READ_COMPOSED_LINE.
X;
X 10$:`009MOVL`009#3,R0`009`009`009`009; At least 3 args for SMG$READ
X`009CMPW`009#2,(AP)`009`009`009`009; How many params did we get?
X`009BEQL`00920$`009`009`009`009; If 2, go handle it
X`009BGTR`00930$`009`009`009`009; If 1, go handle it
X`009`009`009`009`009`009; Here, 3 parameters
X`009PUSHAW`009@RETLEN(AP)`009`009`009; Push address of length word
X`009INCL`009R0`009`009`009`009; Bump up SMG$READ args count
X 20$:`009PUSHAQ`009@PROMPT(AP)`009`009`009; Push prompt desc. address
X`009INCL`009R0`009`009`009`009; Bump up SMG$READ args count
X 30$:`009PUSHAQ`009@BUFFER(AP)`009`009`009; Push address of receive buffer
X`009PUSHAL`009KEY_TABLE_ID`009`009`009; Push the key table id
X`009PUSHAL`009KEYBOARD_ID`009`009`009; Push the keyboard id
X`009CALLS`009R0,G`094SMG$READ_COMPOSED_LINE`009; Call SMG$ routine to read l
Vine
X`009CMPL`009#SMG$_EOF,R0`009`009`009; Was `094Z entered?
X`009BNEQU`00940$`009`009`009`009; No - go on and return
X`009MOVL`009#RMS$_EOF,R0`009`009`009; Make status RMS$_EOF (like LIB$)
X 40$:`009RET`009`009`009`009`009; Return to the caller
X
X`009.END
$ CALL UNPACK HG$GET_INPUT.MAR;1 2051166328
$ create/nolog 'f'
X  `009.TITLE`009LOGIN - Set up environment at LOGIN
X`009.IDENT`009/01-001/
X;========================================================================
X;=`009`009`009`009`009`009`009`009`009=
+-+-+-+-+-+-+-+-  END  OF PART 1 +-+-+-+-+-+-+-+-

