From:	ADVAX::"mcnc!CUNYVM.CUNY.EDU!VMSSERV%WKUVX1.BITNET" 25-FEB-1991 13:32:34.45
To:	arisia::everhart
CC:	
Subj:	DISK$WKUPUB2:[VMSSERV.FILES.LOGIN]LOGIN.01_OF_01;1

Received: by ADVAX.DECnet (utk-mail11 v1.5) ; Mon, 25 Feb 91 13:30:47 EST
Received:  from mcnc by ge-dab.GE.COM (5.61/GE-DAB 1.15) with UUCP
	id AA03675 for ; Mon, 25 Feb 91 12:06:20 -0500
Received: from CUNYVM.CUNY.EDU by mcnc.mcnc.org (5.59/MCNC/6-11-90)
	id AA08899; Mon, 25 Feb 91 10:02:11 -0500
	for arisia.dnet.ge.com!everhart
Message-Id: <9102251502.AA08899@mcnc.mcnc.org>
Received: from WKUVX1.BITNET by CUNYVM.CUNY.EDU (IBM VM SMTP R1.2.2MX) with BSMTP id 6895; Mon, 25 Feb 91 10:02:22 EST
Date: Mon, 25 Feb 91 08:58 CST
From: mcnc!CUNYVM.CUNY.EDU!VMSSERV%WKUVX1.BITNET
Subject: DISK$WKUPUB2:[VMSSERV.FILES.LOGIN]LOGIN.01_OF_01;1
To: arisia::everhart
X-Vms-To: IN%"everhart@arisia.dnet.ge.com"
 
$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.2-007  22-FEB-1990
$!   On  8-FEB-1991 23:25:02.93   By user GOATHUNTER
$!
$! This VMS_SHARE Written by:
$!    Andy Harper, Kings College London UK
$!
$! Acknowledgements to:
$!    James Gray       - Original VMS_SHARE
$!    Michael Bednarek - Original Concept and implementation
$!
$! 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. LOGIN.MAR;1
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$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 = "!"
$ ve=f$getsyi("version")
$ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto START
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ 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 '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 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ if .not. f$verify() then $ 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");b:=
CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b));
LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);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 IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")=
1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF";
POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r);
ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1;
COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE,
"output_file"));ENDPROCEDURE;Unpacker;QUIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create 'f'
X  `09.TITLE`09LOGIN - Set up environment at LOGIN
X`09.IDENT`09/01-001/
X;========================================================================
X;=`09`09`09`09`09`09`09`09`09=
X;=`09Program:`09LOGIN.MAR`09`09`09`09`09=
X;=`09`09`09`09`09`09`09`09`09=
X;=`09Programmer:`09Hunter Goatley`09`09`09`09`09=
X;=`09`09`09Academic Computing, STH 226`09`09`09=
X;=`09`09`09Western Kentucky University`09`09`09=
X;=`09`09`09Bowling Green, KY 42101`09`09`09`09=
X;=`09`09`09Voice:  502-745-5251`09`09`09`09=
X;=`09`09`09E-mail: GOATHUNTER@WKUVX1.bitnet`09`09=
X;=`09`09`09`09`09`09`09`09`09=
X;=`09Date:`09`09March 13, 1988`09`09`09`09`09=
X;=`09`09`09`09`09`09`09`09`09=
X;=`09Purpose:`09Define logicals and foreign commands and other`09=
X;=`09`09`09miscellaneous things at login.`09`09`09=
X;=`09`09`09`09`09`09`09`09`09=
X;========================================================================
X;=`09`09`09`09`09`09`09`09`09=
X;=`09This program was written to be called from a LOGIN.COM to`09=
X;=`09define logicals, global symbols,  and  do other things at`09=
X;=`09login.  It  is  substantially  faster than  a DCL command`09=
X;=`09procedure that does the same things.`09`09`09`09=
X;=`09`09`09`09`09`09`09`09`09=
X;========================================================================
X;
X`09.PAGE
X`09.SBTTL`09Macro and symbol definitions
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
X`09.LINK`09/SYS$SYSTEM:DCLDEF.STB/`09`09; Link to DCL's symbol table
X`09.LINK`09/SYS$SYSTEM:SYS.STB/`09`09; Link to system symbol table
X;
X;  Define all symbols used in this program.
X;
X`09$SSDEF`09`09`09`09`09; System service symbols
X`09$PRVDEF`09`09`09`09`09; Privilege mask symbols
X`09$LIBDEF`09`09`09`09`09; RTL symbols
X`09$JPIDEF`09`09`09`09`09; $GETJPI symbols
X`09$IODEF`09`09`09`09`09; I/O function codes
X`09$DSCDEF`09`09`09`09`09; Descriptor symbols
X`09$TTDEF`09`09`09`09`09; Terminal characteristic
X`09$TT2DEF`09`09`09`09`09; ...  symbols
X`09$CHFDEF`09`09`09`09`09; Condition Handler symbols
X;
X;  Define symbolic offsets for the 7 word array returned by the system servi
Vce
X;  $NUMTIM.
X;
X`09$DEFINI`09TIM`09`09`09`09; Structure for $NUMTIM buffer
X$DEF`09TIM_W_YEAR`09.BLKW`091`09`09; 7 words:`09Year
X$DEF`09TIM_W_MONTH`09.BLKW`091`09`09; ....`09`09Month
X$DEF`09TIM_W_DAY`09.BLKW`091`09`09; ....`09`09Day
X$DEF`09TIM_W_HOUR`09.BLKW`091`09`09; ....`09`09Hour
X$DEF`09TIM_W_MINUTE`09.BLKW`091`09`09; ....`09`09Minute
X$DEF`09TIM_W_SECOND`09.BLKW`091`09`09; ....`09`09Second
X$DEF`09TIM_W_HUNDRED`09.BLKW`091`09`09; ....`09`09Hundredths
X`09$DEFEND`09TIM
X;+
X;  Macro:`09BUILD_DESCS
X;
X;  Purpose:
X;
X;`09This macro is used to set up the descriptors for setting symbols and
X;`09defining logicals.
X;
X;  Implicit inputs:
X;
X;`09R2 - Address of descriptor for the equivalence strings
X;`09R3 - Address of descriptor for the symbol/logical strings
X;`09R4 - Address of next .ASCIC symbol/equivalence pair
X;
X;  Work register:
X;
X;`09R0 - Used for temporary storage of the length of each string
X;-
X`09.MACRO`09BUILD_DESCS
X`09MOVZBL`09(R4)+,R0`09`09; Get the string length
X`09MOVW`09R0,(R2)`09`09`09; Put it in the descriptor
X`09MOVL`09R4,4(R2)`09`09; Set up the address too
X`09ADDL2`09R0,R4`09`09`09; Add to get addr of next string
X`09`09`09`09`09;
X`09MOVZBL`09(R4)+,R0`09`09; Get the string length
X      `09MOVW`09R0,(R3)`09`09`09; Put it in the descriptor
X`09MOVL`09R4,4(R3)`09`09; Set up the address too
X`09ADDL2`09R0,R4`09`09`09; Add to get addr of next string
X`09`09`09`09`09;
X`09.ENDM`09BUILD_DESCS
X
X;+
X;
X;  Macro:`09SYM & LOG
X;
X;  Input:`09Logical/Symbol name and equivalence string
X;
X;  Purpose:
X;
X;`09Build .ASCIC string for each pair of strings.
X;
X;`09Using .ASCIC (as opposed to .ASCID) saves 14 bytes of memory
X;`09for each pair of strings.  This savings of memory makes the
X;`09extra instructions worth using.  The CPU instructions move the
X;`09count and address for each string to two descriptors for the
X;`09Run-Time Library calls.
X;
X;-
X;
X`09.MACRO`09SYM`09SYMBOL,EQUIV
X`09.ASCIC`09?EQUIV?`09`09`09`09; The symbol's equivalence str
X`09.ASCIC`09?SYMBOL?`09`09`09; The symbol name
X`09.ENDM`09SYM
X
X`09.MACRO`09LOG`09LOGICAL,EQUIV
X`09.ASCIC`09?EQUIV?`09`09`09`09; The logical's equivalence str
X`09.ASCIC`09?LOGICAL?`09`09`09; The logical name
X`09.ENDM`09LOG
X
X`09.PAGE
X`09.SBTTL`09Data storage for LOGIN
X
X`09.PSECT`09_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`20
X;======`09 parameters to be passed by descriptor)
X;
XEQUIV_DESC:
X`09`09.WORD`090`09`09`09; Soon to be the string length
X`09`09.BYTE`09DSC$K_DTYPE_T`09`09; The type of string (character)
X`09`09.BYTE`09DSC$K_CLASS_S`09`09; The class (static)
X`09`09.LONG`090`09`09`09; Soon to be the address
X;
X;=====`09The descriptor to be used for all logical names and symbol names
X;=====`09to be defined`20
X;
XSYM_LOG_DESC:
X`09`09.WORD`090`09`09`09; Soon to be the string length
X`09`09.BYTE`09DSC$K_DTYPE_T`09`09; The type of string (character)
X`09`09.BYTE`09DSC$K_CLASS_S`09`09; The class (static)
X`09`09.LONG`090`09`09`09; Soon to be the address
X;
X;  Argument list for call to RTL routine LIB$SET_LOGICAL
X;
XLOG_ARGS:`09.LONG`092`09`09`09; LIB$SET_LOGICAL takes 2 args
X`09`09.ADDRESS SYM_LOG_DESC`09`09; ... The logical to define
X`09`09.ADDRESS EQUIV_DESC`09`09; ... 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:`09.LONG`093`09`09`09; LIB$SET_SYMBOL argument list
X`09`09.ADDRESS SYM_LOG_DESC`09`09; ... The symbol to set
X`09`09.ADDRESS EQUIV_DESC`09`09; ... The equivalence string
X`09`09.ADDRESS 10$`09`09`09; ... The symbol table
X`0910$:`09.LONG`09LIB$K_CLI_GLOBAL_SYM`09; Global symbol table-id
X
X`09.PAGE
X`09.SBTTL`09Process logicals table
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
X;=====`09The logicals to define
X;
XLOGICALS:
X
XLOG`09DBG$INIT`09H:DBGINI.DBG
XLOG`09EDTINI`09`09H:EDTINI.EDT
XLOG`09MAIL$INIT`09H:MAIL$INIT.INI
XLOG`09MAIL$EDIT`09CALLABLE_TPU
XLOG`09TPU$CALLUSER`09ATE:TPU_AUTOSAVE.EXE
XLOG`09TPUSECINI`09ATE:CDS_EVE.TPU$SECTION
XLOG`09H`09`09RD$USER:`5BWHG.HUNTER`5D
XLOG`09MAR`09`09RD$USER:`5BWHG.MAR`5D
XLOG`09WKU$SPELL`09AT$ROOT:`5BDATA`5D
X
X`09.LONG`090`09; End of logicals table
X
X`09.PAGE
X`09.SBTTL`09Global process symbols table
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
X;=====`09The symbols to define
X;
X`09.ALIGN`09LONG
XSYMBOLS:
X
XSYM`09AUDIT`09`09$CLYDE$ROOT:`5BEXE`5DAUDIT.EXE`09; Clyde's AUDIT
XSYM`09KBLOCK`09`09$CLYDE$ROOT:`5BEXE`5DKBLOCK.EXE`09; Clyde's KBLock
XSYM`09CMD`09`09$H:CMD.EXE`09`09; Mess with DCL commands
XSYM`09COMPRESS`09$H:LZCMP.EXE`09`09; DECUS LZW file compression
XSYM`09DECOMPRESS`09$H:LZDCM.EXE`09`09; DECUS LZW file decompression
XSYM`09DETAB`09`09$H:DETAB.EXE`09`09; Replace TABs w/ blanks
XSYM`09ENTAB`09`09$H:ENTAB.EXE`09`09; Replace blanks with tabs
XSYM`09EVESPN`09`09<@H:EVE.COM SPAWN>`09; Spawn EVE process
XSYM`09FLIST`09`09$ATE:FLIST.EXE`09`09; FLIST directory manager
XSYM`09GETCMD`09`09$H:GETCMD.EXE`09`09; Get another user's DCL cmds
XSYM`09INSTALL`09`09$INSTALL/COMMAND`09; INSTALL utility
XSYM`09LO*GOUT`09`09@H:LOGOUT.COM`09`09; Logout
XSYM`09LOGIN`09`09$H:LOGIN.EXE`09`09; Execute LOGIN.EXE
XSYM`09REM*IND`09`09$ATE:REMIND.EXE`09`09; My REMINDer
XSYM`09SD`09`09$H:SD.EXE`09`09; Set default
XSYM`09WKUMON`09`09$H:WKUMON.EXE`09`09; Process monitor program
X
X`09.LONG`090`09; End of symbols table
X
X`09.PAGE
X`09.SBTTL`09PRINT_DATE data
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
XNUMTIM_ARGS:`09$NUMTIM`09TIMBUF=NUMTIMBUF`09; Argument list for $NUMTIM
X;
X;  $FAO control string for "pretty" format date and time.  Example:
X;
X;`09`09Saturday, May 7, 1988  9:29:00 AM
X;
XFAO_TIME:`09.ASCID`09\!/!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`09.ALIGN`09LONG
XDAYS:`09`09.ADDRESS 10$`09`09`09; Day 1 - Monday
X`09`09.ADDRESS 20$`09`09`09; Day 2 - Tuesday
X`09`09.ADDRESS 30$`09`09`09; Day 3 - Wednesday
X`09`09.ADDRESS 40$`09`09`09; Day 4 - Thursday
X`09`09.ADDRESS 50$`09`09`09; Day 5 - Friday
X`09`09.ADDRESS 60$`09`09`09; Day 6 - Saturday
X`09`09.ADDRESS 70$`09`09`09; Day 7 - Sunday
X`0910$:`09.ASCIC`09/Monday/
X`0920$:`09.ASCIC`09/Tuesday/
X`0930$:`09.ASCIC`09/Wednesday/
X`0940$:`09.ASCIC`09/Thursday/
X`0950$:`09.ASCIC`09/Friday/
X`0960$:`09.ASCIC`09/Saturday/
X`0970$: `09.ASCIC`09/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`09.ALIGN`09LONG
XMONTHS:`09`09.ADDRESS 10$`09`09`09; January
X`09`09.ADDRESS 20$`09`09`09; February
X`09`09.ADDRESS 30$`09`09`09; March
X`09`09.ADDRESS 40$`09`09`09; April
X`09`09.ADDRESS 50$`09`09`09; May
X`09`09.ADDRESS 60$`09`09`09; June
X`09`09.ADDRESS 70$`09`09`09; July
X`09`09.ADDRESS 80$`09`09`09; August
X`09`09.ADDRESS 90$`09`09`09; September
X`09`09.ADDRESS 100$`09`09`09; October
X`09`09.ADDRESS 110$`09`09`09; November
X`09`09.ADDRESS 120$`09`09`09; December
X`09 10$:`09.ASCIC`09/January/
X`09 20$:`09.ASCIC`09/February/
X`09 30$:`09.ASCIC`09/March/
X`09 40$:`09.ASCIC`09/April/
X`09 50$:`09.ASCIC`09/May/
X`09 60$:`09.ASCIC`09/June/
X`09 70$:`09.ASCIC`09/July/
X`09 80$:`09.ASCIC`09/August/
X`09 90$:`09.ASCIC`09/September/
X`09100$:`09.ASCIC`09/October/
X`09110$:`09.ASCIC`09/November/
X`09120$:`09.ASCIC`09/December/
X
XAM:`09`09.ASCIC`09/AM/`09`09`09; Ante meridiem
XPM:`09`09.ASCIC`09/PM/`09`09`09; Post meridiem
X`09`09`09`09`09`09;
XNUMTIMBUF:`09.BLKW`097`09`09`09; Buffer for numeric time
X`09`09`09`09`09`09; ...  returned by $NUMTIM
X`09`09`09`09`09`09;
XFAO_ARGS:`09$FAO`09CTRSTR=FAO_TIME, -`09; $FAO argument list for date
X`09`09`09OUTBUF=FAO_OUT, -`09; ...  Output buffer is FAO_OUT
X`09`09`09OUTLEN=FAO_OUT, -`09; ...  Write final length there
X`09`09`09P1=0, -`09`09`09; ...  Will point to weekday
X`09`09`09P2=0, -`09`09`09; ...  Will point to month
X`09`09`09P3=0, -`09`09`09; ...  Will point to day
X`09`09`09P4=0, -`09`09`09; ...  Will point to year
X`09`09`09P5=0, -`09`09`09; ...  Will point to hour
X`09`09`09P6=0, -`09`09`09; ...  Will point to minutes
X`09`09`09P7=0, -`09`09`09; ...  Will point to seconds
X`09`09`09P8=PM`09`09`09; ...  Points to meridiem
X`09`09`09`09`09`09;
XFAO_OUT:`09.WORD`09256`09`09`09; Output buffer (and descriptor)
X`09`09.BYTE`09DSC$K_DTYPE_T`09`09; ... for formatted date and
X`09`09.BYTE`09DSC$K_CLASS_S`09`09; ... time
X`09`09.ADDRESS .+4`09`09`09; ...
X`09`09.BLKB`09256`09`09`09; ... The actual buffer
X;
X
X`09.PAGE
X`09.SBTTL`09SET_PROCESS_NAME data
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
X;==  The process names to set.
X;
XPRCNAM1:`09$SETPRN`09PRCNAM=10$`09`09; $SETPRN argument list
X`0910$:`09.ASCID`09/Polter Goat/`09`09; ...  1st process name
X`09`09.ALIGN`09LONG`09`09`09; Align on longword boundary
XPRCNAM2:`09$SETPRN`09PRCNAM=10$`09`09; ...
X`0910$:`09.ASCID`09/Goat Busters/`09`09; ...  2nd process name
X`09`09.ALIGN`09LONG`09`09`09; Align on longword boundary
XPRCNAM3:`09$SETPRN`09PRCNAM=10$`09`09; ...
X`0910$:`09.ASCID`09/Goat Story/`09`09; ...  3rd process name
X`09`09.ALIGN`09LONG`09`09`09; Align on longword boundary
XPRCNAM4:`09$SETPRN`09PRCNAM=10$`09`09; ...
X`0910$:`09.ASCID`09/Goat Hunter/`09`09; ...  4th process name
X`09`09.ALIGN`09LONG`09`09`09; Align on longword boundary
X
X`09.SBTTL`09$GETJPI data
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
XJPI_ARGS:`09$GETJPI EFN=13, -`09`09; $GETJPI argument list
X`09`09`09ITMLST=10$`09`09; ...
X`0910$:`09`09`09`09`09; Item list for $GETJPI call
X`09`09.WORD`094`09`09`09; Length of buffer
X`09`09.WORD`09JPI$_MODE`09`09; Asking for process mode
X`09`09.ADDRESS MODE`09`09`09; Address of buffer
X`09`09.LONG`090`09`09`09; Ignore length returned
X`09`09.LONG`09JPI$C_LISTEND`09`09; End of JPI_LIST
X
XMODE:`09`09.BLKL`091`09`09`09; Longword for mode indicator
X
XJPI_WAIT:`09$WAITFR`09EFN=13`09`09`09; Wait for $GETJPI to finish
X
X`09.SBTTL`09SET_TT_CHARS data
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
XESC`09= 27`09`09`09`09`09; Escape character - ASCII 27
XSO`09= 15`09`09`09`09`09; Shift Out - ASCII 15
XTTCHAN:`09`09.BLKL`091`09`09`09; Holds I/O channel for TT:
XTTCHARS:`09.BLKB`0912`09`09`09; Buffer to hold characteristics
XSET_APP_KEYPAD:`09.ASCII -`09`09`09; ESC sequences to send to TT
X`09`09`09<ESC>/`5Bm/ -`09`09;  Turn off video attributes
X`09`09`09<ESC>/(B/ -`09`09;  G0 designated as US set
X`09`09`09<ESC>/)B/ -`09`09;  Set G1 character set - ASCII
X`09`09`09<ESC>/`5B62;1"p/ -`09;  Set VT200, 7-bit mode
X`09`09`09<ESC>/`5B?25h/ -`09`09;  Cursor on
X`09`09`09<ESC>/`5B4l/ -`09`09;  Turn insert off
X`09`09`09<ESC>/`5B?7l/ -`09`09;  Turn auto-wrap off
X`09`09`09<ESC>/=/ -`09`09;  Set application keypad
X`09`09`09<SO>`09`09`09;  Enable G1 character set
XSET_APP_KEYPAD_L = . - SET_APP_KEYPAD`09`09; Length of escape sequence
X
XASSIGN_ARGS:`09$ASSIGN`09CHAN=TTCHAN, -`09`09; $ASSIGN argument list
X`09`09`09DEVNAM=10$`09`09; ...  Assign I/O channel to TT:
X`0910$:`09.ASCID`09/SYS$COMMAND:/`09`09; ...
X
XWRITESEQ:`09$QIOW`09CHAN=0, -`09`09; $QIOW argument list to write
X`09`09`09FUNC=IO$_WRITEVBLK, -`09; ...  escape sequence to
X`09`09`09P1=SET_APP_KEYPAD, -`09; ...  the terminal
X`09`09`09P2=SET_APP_KEYPAD_L`09; ...
X
XSENSEMODE:`09$QIOW`09CHAN=0 -`09`09; Get current characteristics
X`09`09`09FUNC=IO$_SENSEMODE -`09; ...  Function SENSEMODE
X`09`09`09P1=TTCHARS -`09`09; ...  Characteristics buffer
X`09`09`09P2=12`09`09`09; ...  Length of buffer
X
XSETMODE:`09$QIOW`09CHAN=0 -`09`09; Set the new characteristics
X`09`09`09FUNC=IO$_SETMODE -`09; ...  Function SETMODE
X`09`09`09P1=TTCHARS -`09`09; ...  Characteristics buffer
X`09`09`09P2=12`09`09`09; ...  Length of buffer
X
X`09.SBTTL`09Miscellaneous 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 =>  `7C world `7C group `7C owner `7C system `7C       4 bits for
V each
X;
XDEFPROT:`09.LONG`092`09`09`09; Argument list for SETDFPROT
X`09`09.ADDRESS 10$`09`09`09; ...  Protection mask address
X`09`09.LONG`090`09`09`09; ...  Don't care what old was
X`0910$:`09.WORD`09`5EB1111111100000000`09; Default RMS file protection
X`09`09`09`09`09`09;   (S:RWED,O:RWED,G,W)
X`09`09.ALIGN`09LONG
XPRIVS:`09`09$SETPRV -`09`09`09; Turn on a few privileges
X`09`09`09ENBFLG=1, -`09`09; ...  Turn them on
X`09`09`09PRVADR=10$, -`09`09; ...
X`09`09`09PRMFLG=1`09`09; ...  Turn them on permanently
X`0910$:`09.QUAD`09-
X`09`09<PRV$M_SYSPRV!PRV$M_WORLD!PRV$M_EXQUOTA! -
X`09`09 PRV$M_GROUP!PRV$M_CMEXEC!PRV$M_OPER>
X
XPRIORITY:`09$SETPRI`09PRI=5`09`09`09; Raise my priority to 5
X
XCTRLMSK:`09.LONG`091`09`09`09; LIB$ENABLE_CTRL argument list
X`09`09.ADDRESS 10$`09`09`09; ...  Address of control mask
X`0910$:`09.LONG`09LIB$M_CLI_CTRLT!LIB$M_CLI_CTRLY
X
X`09.SBTTL`09Argument 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:`09.LONG`093`09`09`09; SYS$SETDDIR argument list
X`09`09.ADDRESS 10$`09`09`09; ... Change default directory
X`09`09.LONG`090`09`09`09; ... Don't care what old
X`09`09.LONG`090`09`09`09; ...   default was
X
X`0910$:`09.ASCID`09/`5BWHG.WORK`5D/`09`09; 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:`09.LONG`092`09`09`09; LIB$SET_LOGICAL argument list
X`09`09.ADDRESS 10$`09`09`09; ... Logical to define
X`09`09.ADDRESS 20$`09`09`09; ... Equivalence string
X`0910$:`09.ASCID`09/SYS$DISK/`09`09; The default disk logical
X`0920$:`09.ASCID`09/$USER:/`09`09; New default disk spec
X`09;
X`09;  *NOTE*`09To change our default disk, we are calling RTL routine
X`09;`09`09LIB$SET_LOGICAL.  We could simply add the new default
X`09;`09`09disk definition to our LOGICALS table:
X`09;
X`09;`09`09`09LOG`09SYS$DISK`09$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:`09.LONG`093`09`09`09; SYS$SETDDIR argument list
X`09`09.LONG`090`09`09`09; ... We're not setting default
X`09`09.ADDRESS PROMPT`09`09`09; ... Return the string and its
X`09`09.ADDRESS PROMPT`09`09`09; ...   length to PROMPT
X
XPROMPT:`09`09.WORD`09256`09`09`09; Descriptor for buffer to
X`09`09.BYTE`09DSC$K_DTYPE_T`09`09; ... receive our default
X`09`09.BYTE`09DSC$K_CLASS_S`09`09; ... directory so that it can
X`09`09.ADDRESS .+4`09`09`09; ... be used as our DCL
X`09`09.BLKB`09256`09`09`09; ... 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:`09.ASCID`09/VAX> /`09`09`09; Another prompt string
X
X`09.PAGE
X`09.SBTTL`09LOGIN entry point - main routine
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
X;`09M A I N   Routine
X;
X`09.PSECT`09_LOGIN_CODE,EXE,NOWRT,LONG,PIC,SHR
X`09.ENTRY`09LOGIN,`5EM<R2,R3,R4,R5>
X`09`09`09`09`09`09;
X`09$GETJPI_G -`09`09`09`09; Get mode of process (batch,
X`09`09JPI_ARGS`09`09`09; ...  interactive, etc.)
X`09`09`09`09`09`09;
X`09BSBW`09DEFINE_LOGICALS`09`09`09; Go define all of our logicals
X`09BSBW`09SET_SYMBOLS`09`09`09; Go set all of our symbols
X`09BSBW`09DO_MISCELLANEOUS`09`09; Go do other things
X`09BSBW`09PRINT_DATE`09`09`09; Go print date and time
X`09`09`09`09`09`09;
X`09$WAITFR_G JPI_WAIT`09`09`09; Wait for $GETJPI to finish
X`09CMPL`09#JPI$K_INTERACTIVE,MODE`09`09; Is process interactive?
X`09BNEQU`0910$`09`09`09`09; No - exit now
X`09`09`09`09`09`09;
X`09BSBW`09SET_PROCESS_NAME`09`09; Go set our process name
X`09BSBW`09SET_TT_CHARS`09`09`09; Set terminal characteristics
X`09`09`09`09`09`09;
X`09BSBW`09SET_DCL_STUFF`09`09`09; Go set DCL things (NOVERIFY)
X`09`09`09`09`09`09; (requires CMKRNL to work)
X 10$:`09MOVL`09#SS$_NORMAL,R0`09`09`09; Return success to VMS
X`09RET`09`09`09`09`09; ...
X
X`09.PAGE
X`09.SBTTL`09DEFINE_LOGICALS subroutine
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
X;  Subroutine:`09DEFINE_LOGICALS
X;
X;  Purpose:`09Define all process logicals.
X;
X;  Inputs:`09LOGICALS, EQUIV_DESC, SYM_LOG_DESC, and LOG_ARGS
X;
XDEFINE_LOGICALS:
X`09MOVAB`09LOGICALS,R4`09`09`09; Get address of first logical
X`09MOVAQ`09EQUIV_DESC,R2`09`09`09; EQUIVALENCE descriptor address
X`09MOVAQ`09SYM_LOG_DESC,R3`09`09`09; LOGICAL descriptor address
X`09MOVAL`09LOG_ARGS,R5`09`09`09; Move the argument list address
X`09`09`09`09`09`09; ... to register for efficiency
X 10$:`09TSTB`09(R4)`09`09`09`09; Are we finished (0 length)?
X`09BEQLU`0920$`09`09`09`09; Yes -- leave
X`09BUILD_DESCS`09`09`09`09; Build the descriptors
X`09CALLG`09(R5),G`5ELIB$SET_LOGICAL`09`09; Go define the logical
X`09BRB`0910$`09`09`09`09; Loop until no more logicals
X 20$:`09RSB`09`09`09`09`09; Return to our caller
X
X`09.PAGE
X`09.SBTTL`09SET_SYMBOLS subroutine
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
X;  Subroutine:`09SET_SYMBOLS
X;
X;  Purpose:`09Set all global process symbols.
X;
X;  Inputs:`09LOGICALS, EQUIV_DESC, SYM_LOG_DESC, and SYM_ARGS
X;
XSET_SYMBOLS:
X`09MOVAQ`09EQUIV_DESC,R2`09`09`09; EQUIVALENCE descriptor address
X`09MOVAQ`09SYM_LOG_DESC,R3`09`09`09; LOGICAL descriptor address
X`09MOVAB`09SYMBOLS,R4`09`09`09; Get address of first symbol
X`09MOVAL`09SYM_ARGS,R5`09`09`09; Move the argument list address
X`09`09`09`09`09`09; ... to register for efficiency
X 10$:`09TSTB`09(R4)`09`09`09`09; Are we finished (0 length)?
X`09BEQLU`0920$`09`09`09`09; Yes -- leave
X`09BUILD_DESCS`09`09`09`09; Build the descriptors
X`09CALLG`09(R5),G`5ELIB$SET_SYMBOL`09`09; Go set the symbol
X`09BRB`0910$`09`09`09`09; Loop until no more symbols
X 20$:`09RSB`09`09`09`09`09; Return to our caller
X
X`09.PAGE
X`09.SBTTL`09PRINT_DATE subroutine
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
X;  Subroutine:`09PRINT_DATE
X;
X;  Purpose:`09Display the current date and time in a "pretty" format.
X;
X;  Inputs:`09FAO_ARGS, NUMTIMBUF, NUMTIM_ARGS, MONTHS, DAYS, FAO_OUT
X;
XPRINT_DATE:
X`09$NUMTIM_G -`09`09`09`09; Get the current time in
X`09`09NUMTIM_ARGS`09`09`09; ... numeric format
X`09MOVAL`09FAO_ARGS,R2`09`09`09; Get address of FAO args list
X`09MOVAL`09NUMTIMBUF,R3`09`09`09; Get address of NUMTIM buffer
X`09CLRL`09-(SP)`09`09`09`09; Make space to receive weekday
X`09PUSHAL`09(SP)`09`09`09`09; Get the day of the week
X`09CLRL`09-(SP)`09`09`09`09; ... and put it on the stack
X`09CALLS`09#2,G`5ELIB$DAY_OF_WEEK`09`09; ...
X`09POPL`09R0`09`09`09`09; Get the day of the week
X`09DECL`09R0`09`09`09`09; Make it point properly
X`09MOVL`09DAYS`5BR0`5D,FAO$_P1(R2)`09`09; Move address to $FAO arglst
X`09MOVZWL`09TIM_W_MONTH(R3),R0`09`09; Get month number
X`09DECL`09R0`09`09`09`09; Make it point properly
X`09MOVL`09MONTHS`5BR0`5D,FAO$_P2(R2)`09`09; Move address to $FAO arglst
X`09MOVZWL`09TIM_W_DAY(R3),FAO$_P3(R2)`09; Move DAY number into FAO list
X`09MOVZWL`09TIM_W_YEAR(R3),FAO$_P4(R2)`09; Move YEAR into FAO arg list
X`09SUBW3`09#12,TIM_W_HOUR(R3),FAO$_P5(R2)`09; Subtract 12 from hour in args
X`09BGTRU`0910$`09`09`09`09; Branch if > 0 (past noon - PM)
X`09MOVAB`09AM,FAO$_P8(R2)`09`09`09; Make it AM instead of PM
X`09ADDW2`09#12,FAO$_P5(R2)`09`09`09; Otherwise, add 12 back in!
X`09BNEQU`0910$`09`09`09`09; Branch if hour is not 0
X`09MOVW`09#12,FAO$_P5(R2)`09`09`09; Make the 0 hour midnight
X10$:`09MOVZWL`09TIM_W_MINUTE(R3),FAO$_P6(R2)`09; Move minutes into FAO arg l
Vist
X`09MOVZWL`09TIM_W_SECOND(R3),FAO$_P7(R2)`09; Move seconds into FAO arg list
X`09$FAO_G`09FAO_ARGS`09`09`09; Format the time
X`09PUSHAQ`09FAO_OUT`09`09`09`09; Print it to SYS$OUTPUT using
X`09CALLS`09#1,G`5ELIB$PUT_OUTPUT`09`09; ...  RTL routine
X`09RSB`09`09`09`09`09; Return to our caller
X
X`09.PAGE
X`09.SBTTL`09SET_TT_CHARS subroutine
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
X;  Subroutine:`09SET_TT_CHARS
X;
X;  Purpose:`09Set terminal characteristics for VT200.
X;
X;  Inputs:`09ASSIGN_ARGS, SENSEMODE, SETMODE, WRITESEQ, TTCHAN, TTCHARS
X;
XSET_TT_CHARS:
X`09$ASSIGN_G ASSIGN_ARGS`09`09`09; Assign I/O channel to TT:
X`09MOVW`09TTCHAN,SENSEMODE+QIOW$_CHAN`09; Move I/O channel to QIO block
X`09MOVW`09TTCHAN,SETMODE+QIOW$_CHAN`09; Move I/O channel to QIO block
X`09MOVW`09TTCHAN,WRITESEQ+QIOW$_CHAN`09; Move I/O channel to QIO block
X`09$QIOW_G`09SENSEMODE`09`09`09; Get current characteristics
X`09;
X`09;  Set new characteristics.  Equivalent to the following DCL command:
X`09;
X`09;`09$ SET TERMINAL/BROADCAST/WRAP/TAB/ANSI/DECCRT/DECCRT2 -
X`09;`09`09/EDIT/LINE/APPLICATION
X`09;
X`09BICL2`09#TT$M_NOBRDCST,TTCHARS+4`09; Clear no broadcast bit
X`09BISL2`09#<TT$M_WRAP!TT$M_MECHTAB>, -`09; Set WRAP and MECHTAB bits
X`09`09TTCHARS+4`09`09`09; ... in basic chars longword
X`09BISL2`09#<TT2$M_ANSICRT!TT2$M_DECCRT! -`09; Set the rest of the chars
X`09`09  TT2$M_DECCRT2!TT2$M_EDIT! -`09; ... in the extended chars
X`09`09  TT2$M_APP_KEYPAD>, -`09`09; ... longword
X`09`09TTCHARS+8`09`09`09; ...
X`09MOVB`09#TT$_VT200_Series,TTCHARS+1`09; Set VT200 device type
X`09$QIOW_G`09SETMODE`09`09`09`09; Set the new characteristics
X`09$QIOW_G`09WRITESEQ`09`09`09; Write ESC sequence to TT:
X`09$DASSGN_S -`09`09`09`09; Deassign terminal I/O channel
X`09`09CHAN=TTCHAN`09`09`09; ...
X`09RSB`09`09`09`09`09; Return to our caller
X
X`09.PAGE
X`09.SBTTL`09SET_PROCESS_NAME subroutine
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
X;  Subroutine:`09SET_PROCESS_NAME
X;
X;  Purpose:`09Set the process name.  If name is already used, select another
X;`09`09name.  Continue until success or no more names.
X;
X;  Inputs:`09PRCNAM1, PRCNAM2, PRCNAM3, PRCNAM4
X;
XSET_PROCESS_NAME:
X`09$SETPRN_G PRCNAM1`09`09`09; Set the process name
X`09BLBS`09R0,10$`09`09`09`09; Branch if successful
X`09;
X`09; If not successful, we're already logged in somewhere.  Try next name.
X`09;
X`09$SETPRN_G PRCNAM2`09`09`09; Set the 2nd process name
X`09BLBS`09R0,10$`09`09`09`09; Branch if successful
X`09`09`09`09`09`09;
X`09$SETPRN_G PRCNAM3`09`09`09; Set the 3rd process name
X`09BLBS`09R0,10$`09`09`09`09; Branch if successful
X`09`09`09`09`09`09;
X`09$SETPRN_G PRCNAM4`09`09`09; Set the 4th process name
X 10$:`09RSB`09`09`09`09`09; Return to our caller
X
X`09.PAGE
X`09.SBTTL`09DO_MISCELLANEOUS subroutine
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
X;  Subroutine:`09DO_MISCELLANEOUS
X;
X;  Purpose:`09This routine performs the same function as the following DCL
X;`09`09commands:
X;`09`09`09$ SET PROTECTION=(S:WRED,O:WRED,G,W)/DEFAULT
X;`09`09`09$ SET PRIVILEGE=(privilege list)
X;`09`09`09$ SET PRIORITY=5
X;`09`09`09$ SET CONTROL=(T,Y)
X;
X;  Inputs:`09PRCNAM1, PRCNAM2, PRCNAM3, PRCNAM4
X;
XDO_MISCELLANEOUS:
X`09CALLG`09DEFPROT,G`5ESYS$SETDFPROT`09`09; Set the default RMS protection
X`09$SETPRV_G PRIVS`09`09`09`09; Turn on more privileges
X`09$SETPRI_G PRIORITY`09`09`09; Set up our priority
X`09CALLG`09CTRLMSK,G`5ELIB$ENABLE_CTRL`09; Enable `5ET and `5EY
X`09RSB`09`09`09`09`09; Return to caller
X
X`09.SBTTL`09SET_DEFAULT subroutine
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
X;  Subroutine:`09SET_DEFAULT
X;
X;  Purpose:`09Change our default disk and directory.
X;
X;  Inputs:`09SET_DDIR, SET_DDISK
X;
XSET_DEFAULT:
X`09CALLG`09SET_DDIR,G`5ESYS$SETDDIR`09`09; Set our default directory
X`09CALLG`09SET_DDISK,G`5ELIB$SET_LOGICAL`09; Change our default disk
X`09RSB`09`09`09`09`09; Return to our caller
X
X`09.PAGE
X`09.SBTTL`09SET_DCL_STUFF subroutine
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
X;  Subroutine:`09SET_DCL_STUFF
X;
X;  Purpose:`09This routine performs the same functionality as the following
X;`09`09DCL commands:
X;`09`09`09`09$ SET NOVERIFY
X;`09`09`09`09$ SET MESSAGE/TEXT/NOIDENT/NOSEVERITY/NOFACILITY
X;`09`09`09`09$ PROMPT = F$DIRECTORY()
X;`09`09`09`09$ SET PROMPT='PROMPT'
X;
X;  *NOTE:`09This routine must go into kernel mode to perform its tasks.
X;`09`09If you do not have CMKRNL privilege, you should not call this
X;`09`09routine (it will simply fail to work if you call it).
X;
X;`09`09If you do not call this routine, you may remove the .LINK
X;`09`09assembler directives at the beginning of this program.
X;
X;  Inputs:`09PROMPT
X;
XSET_DCL_STUFF:
X`09CALLG`09GET_DDIR,G`5ESYS$SETDDIR`09`09; Get default directory to use
X`09`09`09`09`09`09; ... as our prompt
X`09$CMKRNL_S -`09`09`09`09; Need to go into kernel mode
X`09`09ROUTIN=10$`09`09`09; ... to do this stuff
X`09RSB`09`09`09`09`09; Return to our caller
X
X 10$:`09.WORD`09`5EM<R2,R3,R4,R5,R6>`09`09; Entry mask - save registers
X`09MOVAL`09KRNL_HANDLER,(FP)`09`09; Set up ACCVIO handler
X`09`09`09`09`09`09;
X`09MOVB`09#1,G`5ECTL$GB_MSGMASK`09`09; Set MESSAGE mask
X`09`09`09`09`09`09;
X`09MOVAL`09G`5ECTL$AG_CLIDATA,R6`09`09; Get address of CLI data in P1
X`09MOVL`09PPD$L_PRC(R6),R6`09`09; Get address of PRC region
X`09BICW2`09#PRC_M_VERIFY,PRC_W_FLAGS(R6)`09; Turn VERIFY off
X`09`09`09`09`09`09;
X`09MOVAL`09PROMPT,R0`09`09`09; Get address of prompt
X`09ADDB3`09#3,(R0),PRC_B_PROMPTLEN(R6)`09; Set length of prompt (need +3
X`09`09`09`09`09`09; ... to count <CR><LF>_)
X`09MOVC3`09(R0),@4(R0),PRC_G_PROMPT(R6)`09; Move prompt into PRC region
X`09`09`09`09`09`09;
X`09MOVL`09#SS$_NORMAL,R0`09`09`09; Return success
X`09RET`09`09`09`09`09; Return to caller
X
X`09.SBTTL`09KRNL_HANDLER condition handler
X;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
V-=-=
X;
X;  Routine:`09KRNL_HANDLER
X;
X;  Purpose:`09Kernel mode access violation handler.  Declaring this routine
X;`09`09as a condition handler for a kernel mode routine will prevent
X;`09`09the system from crashing if something goes wrong in the routine
X;`09`09(most likely an access violation).
X;
X;`09`09If an access violation occurs, this routine gains control, sets
X;`09`09up call frame to return SS$_ACCVIO, and unwinds to the previous
X;`09`09caller.
X;
X`09.ENTRY`09KRNL_HANDLER,`5EM<>
X`09MOVL`09CHF$L_MCHARGLST(AP),R0`09`09; Get mechanism array address
X`09CLRL`09CHF$L_MCH_SAVR1(R0)`09`09; Clear saved R1 in array
X`09MOVL`09#SS$_ACCVIO,CHF$L_MCH_SAVR0(R0)`09; Put ACCVIO status in saved R0
X`09$UNWIND_S`09`09`09`09; Unwind to previous caller
X`09RET`09`09`09`09`09; Return ACCVIO to caller
X
X`09.END`09LOGIN
$ CALL UNPACK LOGIN.MAR;1 1629775209
$ v=f$verify(v)
$ EXIT
