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

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

-+-+-+-+-+-+-+-+ START OF PART 2 -+-+-+-+-+-+-+-+
X;=`009Program:`009LOGIN.MAR`009`009`009`009`009=
X;=`009`009`009`009`009`009`009`009`009=
X;=`009Programmer:`009Hunter Goatley`009`009`009`009`009=
X;=`009`009`009Clyde Digital Systems`009`009`009`009=
X;=`009`009`009371 East 800 South`009`009`009`009=
X;=`009`009`009Orem, Utah  84058`009`009`009`009=
X;=`009`009`009(801) 224-5306`009`009`009`009`009=
X;=`009`009`009`009`009`009`009`009`009=
X;=`009Date:`009`009March 13, 1988`009`009`009`009`009=
X;=`009`009`009`009`009`009`009`009`009=
X;=`009Purpose:`009Define logicals and foreign commands and other`009=
X;=`009`009`009miscellaneous things at login.`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;=`009This program was written to be called from a LOGIN.COM to`009=
X;=`009define logicals, global symbols,  and  do other things at`009=
X;=`009login.  It  is  substantially  faster than  a DCL command`009=
X;=`009procedure that does the same things.`009`009`009`009=
X;=`009`009`009`009`009`009`009`009`009=
X;========================================================================
X;
X`009.PAGE
X`009.SBTTL`009Macro and symbol definitions
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
X`009.LINK`009/SYS$SYSTEM:DCLDEF.STB/`009`009; Link to DCL's symbol table
X`009.LINK`009/SYS$SYSTEM:SYS.STB/`009`009; Link to system symbol table
X;
X;  Define all symbols used in this program.
X;
X`009$SSDEF`009`009`009`009`009; System service symbols
X`009$PRVDEF`009`009`009`009`009; Privilege mask symbols
X`009$LIBDEF`009`009`009`009`009; RTL symbols
X`009$JPIDEF`009`009`009`009`009; $GETJPI symbols
X`009$IODEF`009`009`009`009`009; I/O function codes
X`009$DSCDEF`009`009`009`009`009; Descriptor symbols
X`009$TTDEF`009`009`009`009`009; Terminal characteristic
X`009$TT2DEF`009`009`009`009`009; ...  symbols
X`009$CHFDEF`009`009`009`009`009; Condition Handler symbols
X;
X;  Define symbolic offsets for the 7 word array returned by the system servi
Vce
X;  $NUMTIM.
X;
X`009$DEFINI`009TIM`009`009`009`009; Structure for $NUMTIM buffer
X$DEF`009TIM_W_YEAR`009.BLKW`0091`009`009; 7 words:`009Year
X$DEF`009TIM_W_MONTH`009.BLKW`0091`009`009; ....`009`009Month
X$DEF`009TIM_W_DAY`009.BLKW`0091`009`009; ....`009`009Day
X$DEF`009TIM_W_HOUR`009.BLKW`0091`009`009; ....`009`009Hour
X$DEF`009TIM_W_MINUTE`009.BLKW`0091`009`009; ....`009`009Minute
X$DEF`009TIM_W_SECOND`009.BLKW`0091`009`009; ....`009`009Second
X$DEF`009TIM_W_HUNDRED`009.BLKW`0091`009`009; ....`009`009Hundredths
X`009$DEFEND`009TIM
X;+
X;  Macro:`009BUILD_DESCS
X;
X;  Purpose:
X;
X;`009This macro is used to set up the descriptors for setting symbols and
X;`009defining logicals.
X;
X;  Implicit inputs:
X;
X;`009R2 - Address of descriptor for the equivalence strings
X;`009R3 - Address of descriptor for the symbol/logical strings
X;`009R4 - Address of next .ASCIC symbol/equivalence pair
X;
X;  Work register:
X;
X;`009R0 - Used for temporary storage of the length of each string
X;-
X`009.MACRO`009BUILD_DESCS
X`009MOVZBL`009(R4)+,R0`009`009; Get the string length
X`009MOVW`009R0,(R2)`009`009`009; Put it in the descriptor
X`009MOVL`009R4,4(R2)`009`009; Set up the address too
X`009ADDL2`009R0,R4`009`009`009; Add to get addr of next string
X`009`009`009`009`009;
X`009MOVZBL`009(R4)+,R0`009`009; Get the string length
X      `009MOVW`009R0,(R3)`009`009`009; Put it in the descriptor
X`009MOVL`009R4,4(R3)`009`009; Set up the address too
X`009ADDL2`009R0,R4`009`009`009; Add to get addr of next string
X`009`009`009`009`009;
X`009.ENDM`009BUILD_DESCS
X
X;+
X;
X;  Macro:`009SYM & LOG
X;
X;  Input:`009Logical/Symbol name and equivalence string
X;
X;  Purpose:
X;
X;`009Build .ASCIC string for each pair of strings.
X;
X;`009Using .ASCIC (as opposed to .ASCID) saves 14 bytes of memory
X;`009for each pair of strings.  This savings of memory makes the
X;`009extra instructions worth using.  The CPU instructions move the
X;`009count and address for each string to two descriptors for the
X;`009Run-Time Library calls.
X;
X;-
X;
X`009.MACRO`009SYM`009SYMBOL,EQUIV
X`009.ASCIC`009?EQUIV?`009`009`009`009; The symbol's equivalence str
X`009.ASCIC`009?SYMBOL?`009`009`009; The symbol name
X`009.ENDM`009SYM
X
X`009.MACRO`009LOG`009LOGICAL,EQUIV
X`009.ASCIC`009?EQUIV?`009`009`009`009; The logical's equivalence str
X`009.ASCIC`009?LOGICAL?`009`009`009; The logical name
X`009.ENDM`009LOG
X
X`009.PAGE
X`009.SBTTL`009Data storage for LOGIN
X
X`009.PSECT`009_LOGIN_DATA,LONG,NOEXE,WRT
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
X;
X;======  The descriptor to be used for all equivalence strings (for both
X;======  logicals and symbols)(LIB$SET_LOGICAL & LIB$SET_SYMBOL expect`032
X;======`009 parameters to be passed by descriptor)
X;
XEQUIV_DESC:
X`009`009.WORD`0090`009`009`009; Soon to be the string length
X`009`009.BYTE`009DSC$K_DTYPE_T`009`009; The type of string (character)
X`009`009.BYTE`009DSC$K_CLASS_S`009`009; The class (static)
X`009`009.LONG`0090`009`009`009; Soon to be the address
X;
X;=====`009The descriptor to be used for all logical names and symbol names
X;=====`009to be defined`032
X;
XSYM_LOG_DESC:
X`009`009.WORD`0090`009`009`009; Soon to be the string length
X`009`009.BYTE`009DSC$K_DTYPE_T`009`009; The type of string (character)
X`009`009.BYTE`009DSC$K_CLASS_S`009`009; The class (static)
X`009`009.LONG`0090`009`009`009; Soon to be the address
X;
X;  Argument list for call to RTL routine LIB$SET_LOGICAL
X;
XLOG_ARGS:`009.LONG`0092`009`009`009; LIB$SET_LOGICAL takes 2 args
X`009`009.ADDRESS SYM_LOG_DESC`009`009; ... The logical to define
X`009`009.ADDRESS EQUIV_DESC`009`009; ... The equivalence value
X;
X;  Argument list for call to RTL routine LIB$SET_SYMBOL
X;
X;  All symbols are defined in the global symbol table (equivalent to using
X;  the double equal signs at DCL - ":==").
X;
XSYM_ARGS:`009.LONG`0093`009`009`009; LIB$SET_SYMBOL argument list
X`009`009.ADDRESS SYM_LOG_DESC`009`009; ... The symbol to set
X`009`009.ADDRESS EQUIV_DESC`009`009; ... The equivalence string
X`009`009.ADDRESS 10$`009`009`009; ... The symbol table
X`00910$:`009.LONG`009LIB$K_CLI_GLOBAL_SYM`009; Global symbol table-id
X
X`009.PAGE
X`009.SBTTL`009Process logicals table
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
X;=====`009The logicals to define
X;
XLOGICALS:
X
XLOG`009DBG$INIT`009H:DBGINI.DBG
XLOG`009EDTINI`009`009H:EDTINI.EDT
XLOG`009MAIL$INIT`009H:MAIL$INIT.INI
XLOG`009MAIL$EDIT`009CALLABLE_TPU
XLOG`009TPU$CALLUSER`009ATE:TPU_AUTOSAVE.EXE
XLOG`009TPUSECINI`009ATE:CDS_EVE.TPU$SECTION
XLOG`009H`009`009RD$USER:`091WHG.HUNTER`093
XLOG`009MAR`009`009RD$USER:`091WHG.MAR`093
XLOG`009WKU$SPELL`009AT$ROOT:`091DATA`093
X
X`009.LONG`0090`009; End of logicals table
X
X`009.PAGE
X`009.SBTTL`009Global process symbols table
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
X;=====`009The symbols to define
X;
X`009.ALIGN`009LONG
XSYMBOLS:
X
XSYM`009AUDIT`009`009$CLYDE$ROOT:`091EXE`093AUDIT.EXE`009; Clyde's AUDIT
XSYM`009KBLOCK`009`009$CLYDE$ROOT:`091EXE`093KBLOCK.EXE`009; Clyde's KBLock
XSYM`009CMD`009`009$H:CMD.EXE`009`009; Mess with DCL commands
XSYM`009COMPRESS`009$H:LZCMP.EXE`009`009; DECUS LZW file compression
XSYM`009DECOMPRESS`009$H:LZDCM.EXE`009`009; DECUS LZW file decompression
XSYM`009DETAB`009`009$H:DETAB.EXE`009`009; Replace TABs w/ blanks
XSYM`009ENTAB`009`009$H:ENTAB.EXE`009`009; Replace blanks with tabs
XSYM`009EVESPN`009`009<@H:EVE.COM SPAWN>`009; Spawn EVE process
XSYM`009FLIST`009`009$ATE:FLIST.EXE`009`009; FLIST directory manager
XSYM`009GETCMD`009`009$H:GETCMD.EXE`009`009; Get another user's DCL cmds
XSYM`009INSTALL`009`009$INSTALL/COMMAND`009; INSTALL utility
XSYM`009LO*GOUT`009`009@H:LOGOUT.COM`009`009; Logout
XSYM`009LOGIN`009`009$H:LOGIN.EXE`009`009; Execute LOGIN.EXE
XSYM`009REM*IND`009`009$ATE:REMIND.EXE`009`009; My REMINDer
XSYM`009SD`009`009$H:SD.EXE`009`009; Set default
XSYM`009WKUMON`009`009$H:WKUMON.EXE`009`009; Process monitor program
X
X`009.LONG`0090`009; End of symbols table
X
X`009.PAGE
X`009.SBTTL`009PRINT_DATE data
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
XNUMTIM_ARGS:`009$NUMTIM`009TIMBUF=NUMTIMBUF`009; Argument list for $NUMTIM
X;
X;  $FAO control string for "pretty" format date and time.  Example:
X;
X;`009`009Saturday, May 7, 1988  9:29:00 AM
X;
XFAO_TIME:`009.ASCID`009\!/!AC, !AC !UB, !UW  !UB:!2ZB:!2ZB !AC!/\
X
X;
X;==  The day names to be used to show the date & time.  The weekday number
X;==  returned by LIB$DAY_OF_WEEK is used as an index into this vector table
X;==  to get the address of the proper weekday string.
X;
X`009.ALIGN`009LONG
XDAYS:`009`009.ADDRESS 10$`009`009`009; Day 1 - Monday
X`009`009.ADDRESS 20$`009`009`009; Day 2 - Tuesday
X`009`009.ADDRESS 30$`009`009`009; Day 3 - Wednesday
X`009`009.ADDRESS 40$`009`009`009; Day 4 - Thursday
X`009`009.ADDRESS 50$`009`009`009; Day 5 - Friday
X`009`009.ADDRESS 60$`009`009`009; Day 6 - Saturday
X`009`009.ADDRESS 70$`009`009`009; Day 7 - Sunday
X`00910$:`009.ASCIC`009/Monday/
X`00920$:`009.ASCIC`009/Tuesday/
X`00930$:`009.ASCIC`009/Wednesday/
X`00940$:`009.ASCIC`009/Thursday/
X`00950$:`009.ASCIC`009/Friday/
X`00960$:`009.ASCIC`009/Saturday/
X`00970$: `009.ASCIC`009/Sunday/
X;
X;==  The month names to be used to show the date & time.  The month returned
X;==  by $NUMTIM is used as an index into this vector table to get the addres
Vs
X;==  of the month name.
X;
X`009.ALIGN`009LONG
XMONTHS:`009`009.ADDRESS 10$`009`009`009; January
X`009`009.ADDRESS 20$`009`009`009; February
X`009`009.ADDRESS 30$`009`009`009; March
X`009`009.ADDRESS 40$`009`009`009; April
X`009`009.ADDRESS 50$`009`009`009; May
X`009`009.ADDRESS 60$`009`009`009; June
X`009`009.ADDRESS 70$`009`009`009; July
X`009`009.ADDRESS 80$`009`009`009; August
X`009`009.ADDRESS 90$`009`009`009; September
X`009`009.ADDRESS 100$`009`009`009; October
X`009`009.ADDRESS 110$`009`009`009; November
X`009`009.ADDRESS 120$`009`009`009; December
X`009 10$:`009.ASCIC`009/January/
X`009 20$:`009.ASCIC`009/February/
X`009 30$:`009.ASCIC`009/March/
X`009 40$:`009.ASCIC`009/April/
X`009 50$:`009.ASCIC`009/May/
X`009 60$:`009.ASCIC`009/June/
X`009 70$:`009.ASCIC`009/July/
X`009 80$:`009.ASCIC`009/August/
X`009 90$:`009.ASCIC`009/September/
X`009100$:`009.ASCIC`009/October/
X`009110$:`009.ASCIC`009/November/
X`009120$:`009.ASCIC`009/December/
X
XAM:`009`009.ASCIC`009/AM/`009`009`009; Ante meridiem
XPM:`009`009.ASCIC`009/PM/`009`009`009; Post meridiem
X`009`009`009`009`009`009;
XNUMTIMBUF:`009.BLKW`0097`009`009`009; Buffer for numeric time
X`009`009`009`009`009`009; ...  returned by $NUMTIM
X`009`009`009`009`009`009;
XFAO_ARGS:`009$FAO`009CTRSTR=FAO_TIME, -`009; $FAO argument list for date
X`009`009`009OUTBUF=FAO_OUT, -`009; ...  Output buffer is FAO_OUT
X`009`009`009OUTLEN=FAO_OUT, -`009; ...  Write final length there
X`009`009`009P1=0, -`009`009`009; ...  Will point to weekday
X`009`009`009P2=0, -`009`009`009; ...  Will point to month
X`009`009`009P3=0, -`009`009`009; ...  Will point to day
X`009`009`009P4=0, -`009`009`009; ...  Will point to year
X`009`009`009P5=0, -`009`009`009; ...  Will point to hour
X`009`009`009P6=0, -`009`009`009; ...  Will point to minutes
X`009`009`009P7=0, -`009`009`009; ...  Will point to seconds
X`009`009`009P8=PM`009`009`009; ...  Points to meridiem
X`009`009`009`009`009`009;
XFAO_OUT:`009.WORD`009256`009`009`009; Output buffer (and descriptor)
X`009`009.BYTE`009DSC$K_DTYPE_T`009`009; ... for formatted date and
X`009`009.BYTE`009DSC$K_CLASS_S`009`009; ... time
X`009`009.ADDRESS .+4`009`009`009; ...
X`009`009.BLKB`009256`009`009`009; ... The actual buffer
X;
X
X`009.PAGE
X`009.SBTTL`009SET_PROCESS_NAME data
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
X;==  The process names to set.
X;
XPRCNAM1:`009$SETPRN`009PRCNAM=10$`009`009; $SETPRN argument list
X`00910$:`009.ASCID`009/Polter Goat/`009`009; ...  1st process name
X`009`009.ALIGN`009LONG`009`009`009; Align on longword boundary
XPRCNAM2:`009$SETPRN`009PRCNAM=10$`009`009; ...
X`00910$:`009.ASCID`009/Goat Busters/`009`009; ...  2nd process name
X`009`009.ALIGN`009LONG`009`009`009; Align on longword boundary
XPRCNAM3:`009$SETPRN`009PRCNAM=10$`009`009; ...
X`00910$:`009.ASCID`009/Goat Story/`009`009; ...  3rd process name
X`009`009.ALIGN`009LONG`009`009`009; Align on longword boundary
XPRCNAM4:`009$SETPRN`009PRCNAM=10$`009`009; ...
X`00910$:`009.ASCID`009/Goat Hunter/`009`009; ...  4th process name
X`009`009.ALIGN`009LONG`009`009`009; Align on longword boundary
X
X`009.SBTTL`009$GETJPI data
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
XJPI_ARGS:`009$GETJPI EFN=13, -`009`009; $GETJPI argument list
X`009`009`009ITMLST=10$`009`009; ...
X`00910$:`009`009`009`009`009; Item list for $GETJPI call
X`009`009.WORD`0094`009`009`009; Length of buffer
X`009`009.WORD`009JPI$_MODE`009`009; Asking for process mode
X`009`009.ADDRESS MODE`009`009`009; Address of buffer
X`009`009.LONG`0090`009`009`009; Ignore length returned
X`009`009.LONG`009JPI$C_LISTEND`009`009; End of JPI_LIST
X
XMODE:`009`009.BLKL`0091`009`009`009; Longword for mode indicator
X
XJPI_WAIT:`009$WAITFR`009EFN=13`009`009`009; Wait for $GETJPI to finish
X
X`009.SBTTL`009SET_TT_CHARS data
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
XESC`009= 27`009`009`009`009`009; Escape character - ASCII 27
XSO`009= 15`009`009`009`009`009; Shift Out - ASCII 15
XTTCHAN:`009`009.BLKL`0091`009`009`009; Holds I/O channel for TT:
XTTCHARS:`009.BLKB`00912`009`009`009; Buffer to hold characteristics
XSET_APP_KEYPAD:`009.ASCII -`009`009`009; ESC sequences to send to TT
X`009`009`009<ESC>/`091m/ -`009`009;  Turn off video attributes
X`009`009`009<ESC>/(B/ -`009`009;  G0 designated as US set
X`009`009`009<ESC>/)B/ -`009`009;  Set G1 character set - ASCII
X`009`009`009<ESC>/`09162;1"p/ -`009;  Set VT200, 7-bit mode
X`009`009`009<ESC>/`091?25h/ -`009`009;  Cursor on
X`009`009`009<ESC>/`0914l/ -`009`009;  Turn insert off
X`009`009`009<ESC>/`091?7l/ -`009`009;  Turn auto-wrap off
X`009`009`009<ESC>/=/ -`009`009;  Set application keypad
X`009`009`009<SO>`009`009`009;  Enable G1 character set
XSET_APP_KEYPAD_L = . - SET_APP_KEYPAD`009`009; Length of escape sequence
X
XASSIGN_ARGS:`009$ASSIGN`009CHAN=TTCHAN, -`009`009; $ASSIGN argument list
X`009`009`009DEVNAM=10$`009`009; ...  Assign I/O channel to TT:
X`00910$:`009.ASCID`009/SYS$COMMAND:/`009`009; ...
X
XWRITESEQ:`009$QIOW`009CHAN=0, -`009`009; $QIOW argument list to write
X`009`009`009FUNC=IO$_WRITEVBLK, -`009; ...  escape sequence to
X`009`009`009P1=SET_APP_KEYPAD, -`009; ...  the terminal
X`009`009`009P2=SET_APP_KEYPAD_L`009; ...
X
XSENSEMODE:`009$QIOW`009CHAN=0 -`009`009; Get current characteristics
X`009`009`009FUNC=IO$_SENSEMODE -`009; ...  Function SENSEMODE
X`009`009`009P1=TTCHARS -`009`009; ...  Characteristics buffer
X`009`009`009P2=12`009`009`009; ...  Length of buffer
X
XSETMODE:`009$QIOW`009CHAN=0 -`009`009; Set the new characteristics
X`009`009`009FUNC=IO$_SETMODE -`009; ...  Function SETMODE
X`009`009`009P1=TTCHARS -`009`009; ...  Characteristics buffer
X`009`009`009P2=12`009`009`009; ...  Length of buffer
X
X`009.SBTTL`009Miscellaneous data storage
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
X;  Argument list for SYS$SETDFPROT system service.  A set bit in the protect
Vion
X;  mask indicates no access.
X;
X;  Fields =>  `124 world `124 group `124 owner `124 system `124       4 bits
V for each
X;
XDEFPROT:`009.LONG`0092`009`009`009; Argument list for SETDFPROT
X`009`009.ADDRESS 10$`009`009`009; ...  Protection mask address
X`009`009.LONG`0090`009`009`009; ...  Don't care what old was
X`00910$:`009.WORD`009`094B1111111100000000`009; Default RMS file protection
X`009`009`009`009`009`009;   (S:RWED,O:RWED,G,W)
X`009`009.ALIGN`009LONG
XPRIVS:`009`009$SETPRV -`009`009`009; Turn on a few privileges
X`009`009`009ENBFLG=1, -`009`009; ...  Turn them on
X`009`009`009PRVADR=10$, -`009`009; ...
X`009`009`009PRMFLG=1`009`009; ...  Turn them on permanently
X`00910$:`009.QUAD`009-
X`009`009<PRV$M_SYSPRV!PRV$M_WORLD!PRV$M_EXQUOTA! -
X`009`009 PRV$M_GROUP!PRV$M_CMEXEC!PRV$M_OPER>
X
XPRIORITY:`009$SETPRI`009PRI=5`009`009`009; Raise my priority to 5
X
XCTRLMSK:`009.LONG`0091`009`009`009; LIB$ENABLE_CTRL argument list
X`009`009.ADDRESS 10$`009`009`009; ...  Address of control mask
X`00910$:`009.LONG`009LIB$M_CLI_CTRLT!LIB$M_CLI_CTRLY
X
X`009.SBTTL`009Argument lists for changing default directory
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
X;
X;  Argument list for call to SYS$SETDDIR to change our default directory.
X;  Note that SYS$SETDDIR does not change the default device - to do that,
X;  we must call LIB$SET_LOGICAL to redefine SYS$DISK.
X;
XSET_DDIR:`009.LONG`0093`009`009`009; SYS$SETDDIR argument list
X`009`009.ADDRESS 10$`009`009`009; ... Change default directory
X`009`009.LONG`0090`009`009`009; ... Don't care what old
X`009`009.LONG`0090`009`009`009; ...   default was
X
X`00910$:`009.ASCID`009/`091WHG.WORK`093/`009`009; New default directory
X;
X;  To specify the default directory, simply place the directory spec between
X;  the two slashes (//) in line 10$ above.
X;
X
XSET_DDISK:`009.LONG`0092`009`009`009; LIB$SET_LOGICAL argument list
X`009`009.ADDRESS 10$`009`009`009; ... Logical to define
X`009`009.ADDRESS 20$`009`009`009; ... Equivalence string
X`00910$:`009.ASCID`009/SYS$DISK/`009`009; The default disk logical
X`00920$:`009.ASCID`009/$USER:/`009`009; New default disk spec
X`009;
X`009;  *NOTE*`009To change our default disk, we are calling RTL routine
X`009;`009`009LIB$SET_LOGICAL.  We could simply add the new default
X`009;`009`009disk definition to our LOGICALS table:
X`009;
X`009;`009`009`009LOG`009SYS$DISK`009$USER
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
X;  Argument list to get our default directory.  This is included as an examp
Vle
X;  of how to get the default directory and use it as our prompt.
X;
XGET_DDIR:`009.LONG`0093`009`009`009; SYS$SETDDIR argument list
X`009`009.LONG`0090`009`009`009; ... We're not setting default
X`009`009.ADDRESS PROMPT`009`009`009; ... Return the string and its
X`009`009.ADDRESS PROMPT`009`009`009; ...   length to PROMPT
X
XPROMPT:`009`009.WORD`009256`009`009`009; Descriptor for buffer to
X`009`009.BYTE`009DSC$K_DTYPE_T`009`009; ... receive our default
X`009`009.BYTE`009DSC$K_CLASS_S`009`009; ... directory so that it can
X`009`009.ADDRESS .+4`009`009`009; ... be used as our DCL
X`009`009.BLKB`009256`009`009`009; ... prompt.
X;
X;  To specify a certain prompt, you can delete the preceding lines and place
X;  the prompt string between the two slashes (//) below.
X;
X;PROMPT:`009.ASCID`009/VAX> /`009`009`009; Another prompt string
X
X`009.PAGE
X`009.SBTTL`009LOGIN entry point - main routine
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
X;`009M A I N   Routine
X;
X`009.PSECT`009_LOGIN_CODE,EXE,NOWRT,LONG,PIC,SHR
X`009.ENTRY`009LOGIN,`094M<R2,R3,R4,R5>
X`009`009`009`009`009`009;
X`009$GETJPI_G -`009`009`009`009; Get mode of process (batch,
X`009`009JPI_ARGS`009`009`009; ...  interactive, etc.)
X`009`009`009`009`009`009;
X`009BSBW`009DEFINE_LOGICALS`009`009`009; Go define all of our logicals
X`009BSBW`009SET_SYMBOLS`009`009`009; Go set all of our symbols
X`009BSBW`009DO_MISCELLANEOUS`009`009; Go do other things
X`009BSBW`009PRINT_DATE`009`009`009; Go print date and time
X`009`009`009`009`009`009;
X`009$WAITFR_G JPI_WAIT`009`009`009; Wait for $GETJPI to finish
X`009CMPL`009#JPI$K_INTERACTIVE,MODE`009`009; Is process interactive?
X`009BNEQU`00910$`009`009`009`009; No - exit now
X`009`009`009`009`009`009;
X`009BSBW`009SET_PROCESS_NAME`009`009; Go set our process name
X`009BSBW`009SET_TT_CHARS`009`009`009; Set terminal characteristics
X`009`009`009`009`009`009;
X`009BSBW`009SET_DCL_STUFF`009`009`009; Go set DCL things (NOVERIFY)
X`009`009`009`009`009`009; (requires CMKRNL to work)
X 10$:`009MOVL`009#SS$_NORMAL,R0`009`009`009; Return success to VMS
X`009RET`009`009`009`009`009; ...
X
X`009.PAGE
X`009.SBTTL`009DEFINE_LOGICALS subroutine
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
X;  Subroutine:`009DEFINE_LOGICALS
X;
X;  Purpose:`009Define all process logicals.
X;
X;  Inputs:`009LOGICALS, EQUIV_DESC, SYM_LOG_DESC, and LOG_ARGS
X;
XDEFINE_LOGICALS:
X`009MOVAB`009LOGICALS,R4`009`009`009; Get address of first logical
X`009MOVAQ`009EQUIV_DESC,R2`009`009`009; EQUIVALENCE descriptor address
X`009MOVAQ`009SYM_LOG_DESC,R3`009`009`009; LOGICAL descriptor address
X`009MOVAL`009LOG_ARGS,R5`009`009`009; Move the argument list address
X`009`009`009`009`009`009; ... to register for efficiency
X 10$:`009TSTB`009(R4)`009`009`009`009; Are we finished (0 length)?
X`009BEQLU`00920$`009`009`009`009; Yes -- leave
X`009BUILD_DESCS`009`009`009`009; Build the descriptors
X`009CALLG`009(R5),G`094LIB$SET_LOGICAL`009`009; Go define the logical
X`009BRB`00910$`009`009`009`009; Loop until no more logicals
X 20$:`009RSB`009`009`009`009`009; Return to our caller
X
X`009.PAGE
X`009.SBTTL`009SET_SYMBOLS subroutine
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
X;  Subroutine:`009SET_SYMBOLS
X;
X;  Purpose:`009Set all global process symbols.
X;
X;  Inputs:`009LOGICALS, EQUIV_DESC, SYM_LOG_DESC, and SYM_ARGS
X;
XSET_SYMBOLS:
X`009MOVAQ`009EQUIV_DESC,R2`009`009`009; EQUIVALENCE descriptor address
X`009MOVAQ`009SYM_LOG_DESC,R3`009`009`009; LOGICAL descriptor address
X`009MOVAB`009SYMBOLS,R4`009`009`009; Get address of first symbol
X`009MOVAL`009SYM_ARGS,R5`009`009`009; Move the argument list address
X`009`009`009`009`009`009; ... to register for efficiency
X 10$:`009TSTB`009(R4)`009`009`009`009; Are we finished (0 length)?
X`009BEQLU`00920$`009`009`009`009; Yes -- leave
X`009BUILD_DESCS`009`009`009`009; Build the descriptors
X`009CALLG`009(R5),G`094LIB$SET_SYMBOL`009`009; Go set the symbol
X`009BRB`00910$`009`009`009`009; Loop until no more symbols
X 20$:`009RSB`009`009`009`009`009; Return to our caller
X
X`009.PAGE
X`009.SBTTL`009PRINT_DATE subroutine
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
X;  Subroutine:`009PRINT_DATE
X;
X;  Purpose:`009Display the current date and time in a "pretty" format.
X;
X;  Inputs:`009FAO_ARGS, NUMTIMBUF, NUMTIM_ARGS, MONTHS, DAYS, FAO_OUT
X;
XPRINT_DATE:
X`009$NUMTIM_G -`009`009`009`009; Get the current time in
X`009`009NUMTIM_ARGS`009`009`009; ... numeric format
X`009MOVAL`009FAO_ARGS,R2`009`009`009; Get address of FAO args list
X`009MOVAL`009NUMTIMBUF,R3`009`009`009; Get address of NUMTIM buffer
X`009CLRL`009-(SP)`009`009`009`009; Make space to receive weekday
X`009PUSHAL`009(SP)`009`009`009`009; Get the day of the week
X`009CLRL`009-(SP)`009`009`009`009; ... and put it on the stack
X`009CALLS`009#2,G`094LIB$DAY_OF_WEEK`009`009; ...
X`009POPL`009R0`009`009`009`009; Get the day of the week
X`009DECL`009R0`009`009`009`009; Make it point properly
X`009MOVL`009DAYS`091R0`093,FAO$_P1(R2)`009`009; Move address to $FAO arglst
X`009MOVZWL`009TIM_W_MONTH(R3),R0`009`009; Get month number
X`009DECL`009R0`009`009`009`009; Make it point properly
X`009MOVL`009MONTHS`091R0`093,FAO$_P2(R2)`009`009; Move address to $FAO argls
Vt
X`009MOVZWL`009TIM_W_DAY(R3),FAO$_P3(R2)`009; Move DAY number into FAO list
X`009MOVZWL`009TIM_W_YEAR(R3),FAO$_P4(R2)`009; Move YEAR into FAO arg list
X`009SUBW3`009#12,TIM_W_HOUR(R3),FAO$_P5(R2)`009; Subtract 12 from hour in ar
Vgs
X`009BGTRU`00910$`009`009`009`009; Branch if > 0 (past noon - PM)
X`009MOVAB`009AM,FAO$_P8(R2)`009`009`009; Make it AM instead of PM
X`009ADDW2`009#12,FAO$_P5(R2)`009`009`009; Otherwise, add 12 back in!
X`009BNEQU`00910$`009`009`009`009; Branch if hour is not 0
X`009MOVW`009#12,FAO$_P5(R2)`009`009`009; Make the 0 hour midnight
X10$:`009MOVZWL`009TIM_W_MINUTE(R3),FAO$_P6(R2)`009; Move minutes into FAO ar
Vg list
X`009MOVZWL`009TIM_W_SECOND(R3),FAO$_P7(R2)`009; Move seconds into FAO arg li
Vst
X`009$FAO_G`009FAO_ARGS`009`009`009; Format the time
X`009PUSHAQ`009FAO_OUT`009`009`009`009; Print it to SYS$OUTPUT using
X`009CALLS`009#1,G`094LIB$PUT_OUTPUT`009`009; ...  RTL routine
X`009RSB`009`009`009`009`009; Return to our caller
X
X`009.PAGE
X`009.SBTTL`009SET_TT_CHARS subroutine
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
X;  Subroutine:`009SET_TT_CHARS
X;
X;  Purpose:`009Set terminal characteristics for VT200.
X;
X;  Inputs:`009ASSIGN_ARGS, SENSEMODE, SETMODE, WRITESEQ, TTCHAN, TTCHARS
X;
XSET_TT_CHARS:
X`009$ASSIGN_G ASSIGN_ARGS`009`009`009; Assign I/O channel to TT:
X`009MOVW`009TTCHAN,SENSEMODE+QIOW$_CHAN`009; Move I/O channel to QIO block
X`009MOVW`009TTCHAN,SETMODE+QIOW$_CHAN`009; Move I/O channel to QIO block
X`009MOVW`009TTCHAN,WRITESEQ+QIOW$_CHAN`009; Move I/O channel to QIO block
X`009$QIOW_G`009SENSEMODE`009`009`009; Get current characteristics
X`009;
X`009;  Set new characteristics.  Equivalent to the following DCL command:
X`009;
X`009;`009$ SET TERMINAL/BROADCAST/WRAP/TAB/ANSI/DECCRT/DECCRT2 -
X`009;`009`009/EDIT/LINE/APPLICATION
X`009;
X`009BICL2`009#TT$M_NOBRDCST,TTCHARS+4`009; Clear no broadcast bit
X`009BISL2`009#<TT$M_WRAP!TT$M_MECHTAB>, -`009; Set WRAP and MECHTAB bits
X`009`009TTCHARS+4`009`009`009; ... in basic chars longword
X`009BISL2`009#<TT2$M_ANSICRT!TT2$M_DECCRT! -`009; Set the rest of the chars
X`009`009  TT2$M_DECCRT2!TT2$M_EDIT! -`009; ... in the extended chars
X`009`009  TT2$M_APP_KEYPAD>, -`009`009; ... longword
X`009`009TTCHARS+8`009`009`009; ...
X`009MOVB`009#TT$_VT200_Series,TTCHARS+1`009; Set VT200 device type
X`009$QIOW_G`009SETMODE`009`009`009`009; Set the new characteristics
X`009$QIOW_G`009WRITESEQ`009`009`009; Write ESC sequence to TT:
X`009$DASSGN_S -`009`009`009`009; Deassign terminal I/O channel
X`009`009CHAN=TTCHAN`009`009`009; ...
X`009RSB`009`009`009`009`009; Return to our caller
X
X`009.PAGE
X`009.SBTTL`009SET_PROCESS_NAME subroutine
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
X;  Subroutine:`009SET_PROCESS_NAME
X;
X;  Purpose:`009Set the process name.  If name is already used, select anothe
Vr
X;`009`009name.  Continue until success or no more names.
X;
X;  Inputs:`009PRCNAM1, PRCNAM2, PRCNAM3, PRCNAM4
X;
XSET_PROCESS_NAME:
X`009$SETPRN_G PRCNAM1`009`009`009; Set the process name
X`009BLBS`009R0,10$`009`009`009`009; Branch if successful
X`009;
X`009; If not successful, we're already logged in somewhere.  Try next name.
X`009;
X`009$SETPRN_G PRCNAM2`009`009`009; Set the 2nd process name
X`009BLBS`009R0,10$`009`009`009`009; Branch if successful
X`009`009`009`009`009`009;
X`009$SETPRN_G PRCNAM3`009`009`009; Set the 3rd process name
X`009BLBS`009R0,10$`009`009`009`009; Branch if successful
X`009`009`009`009`009`009;
X`009$SETPRN_G PRCNAM4`009`009`009; Set the 4th process name
X 10$:`009RSB`009`009`009`009`009; Return to our caller
X
X`009.PAGE
X`009.SBTTL`009DO_MISCELLANEOUS subroutine
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
X;  Subroutine:`009DO_MISCELLANEOUS
X;
X;  Purpose:`009This routine performs the same function as the following DCL
X;`009`009commands:
X;`009`009`009$ SET PROTECTION=(S:WRED,O:WRED,G,W)/DEFAULT
X;`009`009`009$ SET PRIVILEGE=(privilege list)
X;`009`009`009$ SET PRIORITY=5
X;`009`009`009$ SET CONTROL=(T,Y)
X;
X;  Inputs:`009PRCNAM1, PRCNAM2, PRCNAM3, PRCNAM4
X;
XDO_MISCELLANEOUS:
X`009CALLG`009DEFPROT,G`094SYS$SETDFPROT`009`009; Set the default RMS protect
Vion
X`009$SETPRV_G PRIVS`009`009`009`009; Turn on more privileges
X`009$SETPRI_G PRIORITY`009`009`009; Set up our priority
X`009CALLG`009CTRLMSK,G`094LIB$ENABLE_CTRL`009; Enable `094T and `094Y
X`009RSB`009`009`009`009`009; Return to caller
X
X`009.SBTTL`009SET_DEFAULT subroutine
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
X;  Subroutine:`009SET_DEFAULT
X;
X;  Purpose:`009Change our default disk and directory.
X;
X;  Inputs:`009SET_DDIR, SET_DDISK
X;
XSET_DEFAULT:
X`009CALLG`009SET_DDIR,G`094SYS$SETDDIR`009`009; Set our default directory
X`009CALLG`009SET_DDISK,G`094LIB$SET_LOGICAL`009; Change our default disk
X`009RSB`009`009`009`009`009; Return to our caller
X
X`009.PAGE
X`009.SBTTL`009SET_DCL_STUFF subroutine
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
X;  Subroutine:`009SET_DCL_STUFF
X;
X;  Purpose:`009This routine performs the same functionality as the following
X;`009`009DCL commands:
X;`009`009`009`009$ SET NOVERIFY
X;`009`009`009`009$ SET MESSAGE/TEXT/NOIDENT/NOSEVERITY/NOFACILITY
X;`009`009`009`009$ PROMPT = F$DIRECTORY()
X;`009`009`009`009$ SET PROMPT='PROMPT'
X;
X;  *NOTE:`009This routine must go into kernel mode to perform its tasks.
X;`009`009If you do not have CMKRNL privilege, you should not call this
X;`009`009routine (it will simply fail to work if you call it).
X;
X;`009`009If you do not call this routine, you may remove the .LINK
X;`009`009assembler directives at the beginning of this program.
X;
X;  Inputs:`009PROMPT
X;
XSET_DCL_STUFF:
X`009CALLG`009GET_DDIR,G`094SYS$SETDDIR`009`009; Get default directory to use
X`009`009`009`009`009`009; ... as our prompt
X`009$CMKRNL_S -`009`009`009`009; Need to go into kernel mode
X`009`009ROUTIN=10$`009`009`009; ... to do this stuff
X`009RSB`009`009`009`009`009; Return to our caller
X
X 10$:`009.WORD`009`094M<R2,R3,R4,R5,R6>`009`009; Entry mask - save registers
X`009MOVAL`009KRNL_HANDLER,(FP)`009`009; Set up ACCVIO handler
X`009`009`009`009`009`009;
X`009MOVB`009#1,G`094CTL$GB_MSGMASK`009`009; Set MESSAGE mask
X`009`009`009`009`009`009;
X`009MOVAL`009G`094CTL$AG_CLIDATA,R6`009`009; Get address of CLI data in P1
X`009MOVL`009PPD$L_PRC(R6),R6`009`009; Get address of PRC region
X`009BICW2`009#PRC_M_VERIFY,PRC_W_FLAGS(R6)`009; Turn VERIFY off
X`009`009`009`009`009`009;
X`009MOVAL`009PROMPT,R0`009`009`009; Get address of prompt
X`009ADDB3`009#3,(R0),PRC_B_PROMPTLEN(R6)`009; Set length of prompt (need +3
X`009`009`009`009`009`009; ... to count <CR><LF>_)
X`009MOVC3`009(R0),@4(R0),PRC_G_PROMPT(R6)`009; Move prompt into PRC region
X`009`009`009`009`009`009;
X`009MOVL`009#SS$_NORMAL,R0`009`009`009; Return success
X`009RET`009`009`009`009`009; Return to caller
X
X`009.SBTTL`009KRNL_HANDLER condition handler
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
X;  Routine:`009KRNL_HANDLER
X;
X;  Purpose:`009Kernel mode access violation handler.  Declaring this routine
X;`009`009as a condition handler for a kernel mode routine will prevent
X;`009`009the system from crashing if something goes wrong in the routine
X;`009`009(most likely an access violation).
X;
X;`009`009If an access violation occurs, this routine gains control, sets
X;`009`009up call frame to return SS$_ACCVIO, and unwinds to the previous
X;`009`009caller.
X;
X`009.ENTRY`009KRNL_HANDLER,`094M<>
X`009MOVL`009CHF$L_MCHARGLST(AP),R0`009`009; Get mechanism array address
X`009CLRL`009CHF$L_MCH_SAVR1(R0)`009`009; Clear saved R1 in array
X`009MOVL`009#SS$_ACCVIO,CHF$L_MCH_SAVR0(R0)`009; Put ACCVIO status in saved
V R0
X`009$UNWIND_S`009`009`009`009; Unwind to previous caller
X`009RET`009`009`009`009`009; Return ACCVIO to caller
X
X`009.END`009LOGIN
$ CALL UNPACK LOGIN.MAR;1 1247769696
$ create/nolog 'f'
X`009.TITLE`009SET_DCL_PROMPT - Change the DCL prompt
X`009.IDENT`009/01-001/
X;========================================================================
X;=`009`009`009`009`009`009`009`009`009=
X;=`009Program:`009PROMPT.MAR`009`009`009`009`009=
X;=`009`009`009`009`009`009`009`009`009=
X;=`009Programmer:`009Hunter Goatley`009`009`009`009`009=
X;=`009`009`009Clyde Digital Systems`009`009`009`009=
X;=`009`009`009371 East 800 South`009`009`009`009=
X;=`009`009`009Orem, Utah  84058`009`009`009`009=
X;=`009`009`009(801) 224-5306`009`009`009`009`009=
X;=`009`009`009`009`009`009`009`009`009=
X;=`009Home:`009`00944 East 600 South`009`009`009`009=
X;=`009`009`009Orem, Utah 84058`009`009`009`009=
X;=`009EasyLink:`00962128960`009`009`009`009`009=
X;=`009FAX:`009`009801-225-7684`009`009`009`009`009=
X;=`009`009`009`009`009`009`009`009`009=
X;=`009Date:`009`009December 7, 1988`009`009`009`009=
X;=`009`009`009`009`009`009`009`009`009=
X;=`009Purpose:`009Set the DCL prompt for a process.`009`009=
X;=`009`009`009`009`009`009`009`009`009=
X;========================================================================
X;
X;
X;  This program also performs the functions:
X;
X;`009$ SET MESSAGE/NOFAC/NOSEV/NOIDENT
X;`009$ SET NOVERIFY
X;`009$ SET PROMPT="May I help you? "
X;
X;  To build:
X;
X;`009$ MACRO PROMPT
X;`009$ LINK PROMPT
X;`009$ RUN PROMPT
X;
X;  To make this callable, simply remove the label "SET_DCL_PROMPT" from the
X;`009last line (.END).
X;
X;`009CALL SET_DCL_PROMPT()
X;
X;  To pass the new prompt as an argument, uncomment the lines between the li
Vnes
X;`009;*********.  This would look like CALL SET_DCL_PROMPT ("New Prompt").
X;
X;  DCL requires that the prompt be less than or equal to 32 characters.
X;
X;
X;  Calling from FORTRAN:
X;
X;`009PROGRAM X
X;`009EXTERNAL SET_DCL_PROMPT
X;`009CALL SET_DCL_PROMPT (%DESCR('Hello: '))
X;`009END
X;
X
X`009.LIBRARY`009/SYS$LIBRARY:LIB.MLB/`009`009; Needed for $PHDDEF
X;
X;  Link to two of the system symbol tables (DCL and SYS)
X;
X`009.LINK`009"SYS$SYSTEM:DCLDEF.STB"/SELECTIVE_SEARCH
X`009.LINK`009"SYS$SYSTEM:SYS.STB"/SELECTIVE_SEARCH
X
X`009$CHFDEF`009`009`009`009`009; Condition Handler symbols
X`009$PHDDEF`009`009`009`009`009; Process Header symbols
X
X`009.PSECT`009_SET_DCL_PROMPT_DATA,NOEXE,NOWRT,LONG
X
XPROMPT:`009`009.ASCID`009/May I help you? /`009; The new prompt
X
XASSUME`009<.-PROMPT-8> LE 32`009`009`009; Prompt must be less than 32
X
X
X`009.PSECT`009_SET_DCL_PROMPT_EXE,EXE,NOWRT,LONG
X
X`009.ENTRY`009SET_DCL_PROMPT,`094M<>
X;******
X;`009$CMKRNL_S -`009`009`009`009; Need to go into kernel mode
X;`009`009ROUTIN=10$,-`009`009`009; ... to do this stuff
X;`009`009ARGLST=(AP)`009`009`009; ...
X;******
X`009$CMKRNL_S -`009`009`009`009; Need to go into kernel mode
X`009`009ROUTIN=10$`009`009`009; ... to do this stuff
X`009RET`009`009`009`009`009; Return to our caller
X
X 10$:`009.WORD`009`094M<R2,R3,R4,R5,R6>`009`009; Entry mask - save registers
X`009MOVAL`009KRNL_HANDLER,(FP)`009`009; Set up ACCVIO handler
X`009`009`009`009`009`009;
X`009MOVB`009#1,G`094CTL$GB_MSGMASK`009`009; Set MESSAGE mask
X`009`009`009`009`009`009;
X`009MOVAL`009G`094CTL$AG_CLIDATA,R6`009`009; Get address of CLI data in P1
X`009MOVL`009PPD$L_PRC(R6),R6`009`009; Get address of PRC region
X`009BICW2`009#PRC_M_VERIFY,PRC_W_FLAGS(R6)`009; Turn VERIFY off
X`009`009`009`009`009`009;
X;********`009`009`009`009`009; To pass a prompt in
X;`009MOVL`0094(AP),R0`009`009`009; Move address of prompt to R0
X;`009CMPB`009#32,(R0)`009`009`009; Is it less than 32 characters?
X;`009BLSS`00920$`009`009`009`009; No - return to caller
X;********
X
X`009MOVAL`009PROMPT,R0`009`009`009; Get address of prompt
X`009ADDB3`009#3,(R0),PRC_B_PROMPTLEN(R6)`009; Set length of prompt (need +3
X`009`009`009`009`009`009; ... to count <CR><LF>_)
X`009MOVC3`009(R0),@4(R0),PRC_G_PROMPT(R6)`009; Move prompt into PRC region
X`009`009`009`009`009`009;
X 20$:`009MOVL`009#SS$_NORMAL,R0`009`009`009; Return success
X`009RET`009`009`009`009`009; Return to caller
X
X`009.SBTTL`009KRNL_HANDLER condition handler
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
X;  Routine:`009KRNL_HANDLER
X;
X;  Purpose:`009Kernel mode access violation handler.  Declaring this routine
X;`009`009as a condition handler for a kernel mode routine will prevent
X;`009`009the system from crashing if something goes wrong in the routine
X;`009`009(most likely an access violation).
X;
X;`009`009If an access violation occurs, this routine gains control, sets
X;`009`009up call frame to return SS$_ACCVIO, and unwinds to the previous
X;`009`009caller.
X;
X`009.ENTRY`009KRNL_HANDLER,`094M<>
X`009MOVL`009CHF$L_MCHARGLST(AP),R0`009`009; Get mechanism array address
X`009CLRL`009CHF$L_MCH_SAVR1(R0)`009`009; Clear saved R1 in array
X`009MOVL`009#SS$_ACCVIO,CHF$L_MCH_SAVR0(R0)`009; Put ACCVIO status in saved
V R0
X`009$UNWIND_S`009`009`009`009; Unwind to previous caller
X`009RET`009`009`009`009`009; Return ACCVIO to caller
X
X`009.END`009SET_DCL_PROMPT
$ CALL UNPACK SET_DCL_PROMPT.MAR;1 37843122
$ create/nolog 'f'
X! DCL RECALL patches for VMS V5.0 --- Extend # of commands that can be recal
Vled
X!
X! This patch uses the REPLACE command instead of DEPOSIT.  The REPLACE
X! command automatically prevents you from making a mistake by forcing you
X! to enter the instruction(s) you intend to replace.  If what you enter does
X! not match the code that is there, an error is generated and no patch is ma
Vde.
X!
XDCL.EXE
XREPL/INST 65ED+8
X'CMPB B`0940C5(R10),#15'
XEXIT
X'CMPB B`0940C5(R10),#3F'
XEXIT
XREPLA/INST 6618
X'CMPB B`0940C5(R10),#15'
XEXIT
X'CMPB B`0940C5(R10),#3F'
XEXIT
XREPL/INST 6662+4
X'CMPB B`0940C5(R10),#15'
XEXIT
X'CMPB B`0940C5(R10),#3F'
XEXIT
XREPL/INST 6AFA
X'CMPL R1,#14'
XEXIT
X'CMPL R1,#3E'
XEXIT
XREPL/INST 6B20
X'MOVL #14,R6'
XEXIT
X'MOVL #3E,R6'
XEXIT
XREPL/INS 6B38
X'MOVL #14,R9'
XEXIT
X'MOVL #3E,R9'
XEXIT
XREPL/INST 6BE7
X'CMPB (R2),#31'
X'BNEQ 6BF3'
X'MOVW #2F32,(R2)'
X'BRB 6BF8'
X'MOVW #2F31,(R2)'
XEXIT
X'CMPB (R2),#20'
X'BNEQ 6BEF'
X'MOVB #30,(R2)'
X'INCB (R2)'
X'MOVB #2F,B`09401(R2)'
XEXIT
XUPDATE
XEXIT
$ CALL UNPACK DCL_RECALL_V5_0.PATCH;1 438307560
$ create/nolog 'f'
X! DCL RECALL patches for VMS V5.2 --- Extend # of commands that can be recal
Vled
X!
X! This patch uses the REPLACE command instead of DEPOSIT.  The REPLACE
X! command automatically prevents you from making a mistake by forcing you
X! to enter the instruction(s) you intend to replace.  If what you enter does
X! not match the code that is there, an error is generated and no patch is ma
Vde.
X!
XDCL.EXE
XREPL/INST 67AC
X'CMPB B`0940C3(R10),#15'
XEXIT
X'CMPB B`0940C3(R10),#3F'
XEXIT
XREPLA/INST 67CF
X'CMPB B`0940C3(R10),#15'
XEXIT
X'CMPB B`0940C3(R10),#3F'
XEXIT
XREPL/INST 681D
X'CMPB B`0940C3(R10),#15'
XEXIT
X'CMPB B`0940C3(R10),#3F'
XEXIT
XREPL/INST 6CBA
X'CMPL R1,#14'
XEXIT
X'CMPL R1,#3E'
XEXIT
XREPL/INST 6CE0
X'MOVL #14,R6'
XEXIT
X'MOVL #3E,R6'
XEXIT
XREPL/INS 6CF8
X'MOVL #14,R9'
XEXIT
X'MOVL #3E,R9'
XEXIT
XREPL/INST 6DA7
X'CMPB (R2),#31'
X'BNEQ 6DB3'
X'MOVW #2F32,(R2)'
X'BRB 6DB8'
X'MOVW #2F31,(R2)'
XEXIT
X'CMPB (R2),#20'
X'BNEQ 6DAF'
X'MOVB #30,(R2)'
X'INCB (R2)'
X'MOVB #2F,B`09401(R2)'
XEXIT
XUPDATE
XEXIT
$ CALL UNPACK DCL_RECALL_V5_2.PATCH;1 1848051124
$ EXIT

