VAX Professional: The Extended LOGIN program

 

The Extended LOGIN Program

by Hunter Goatley

Clyde Digital Systems

When my article “DCL Key Definition Routines” appeared in the February 1988 issue of VAX Professional, there was quite a bit of interest generated by my LOGIN program. The program was designed to perform most of the tasks that I had been doing from my LOGIN.COM procedure, without the overhead of the tasks. The program as it was submitted was merely a “bare-bones” version of the LOGIN program I actually use, so I will now write about the extended version.

As I mentioned in my previous article, my LOGIN program was initially written to define all of my process logicals and symbols. As my knowledge of VMS grew and I became aware of the overhead caused by some of my LOGIN tasks, I realized that there were system services that could be called from a program to perform many of those functions. My program grew accordingly, steadily decreasing the length of my login time. Many of the customizations executed via the LOGIN.COM result in needless image activations, considerably slowing down the login process. In the course of this article, I will discuss a little bit about programming in the MACRO-32 assembly language, as well as provide an overview of some useful system services and library routines available through VMS.

The program presented here provides examples of calls to some useful run-time library routines and system services. While I have found the program useful, you may or may not find the program beneficial for your site; in either case, be aware that the time savings vary depending on the tasks performed and you may not see much, if any, reduction in your login time. In my previous article, Dave Mallery, Editorial Director for Professional Press, commented that the login time on his system was decreased from 15 seconds to 5 seconds after he implemented a version of my program. Again, please note that this may not be true of your system.

MACRO and some language features

Being a fan of the MACRO-32 assembly language, I decided to use it to gain maximum performance for my LOGIN program (Program 1); any language could have been used, but MACRO will provide the fastest environment.

There are two forms of the CALL instruction in MACRO: CALLS and CALLG. They differ in the way their argument lists are created for the call to the external procedure. For CALLS, the argument list is built on the stack; for CALLG, the argument list may be built anywhere (its address is one of the operands for CALLG). I chose to use the CALLG form for a couple of reasons: it’s faster, and I think it’s easier to read than the CALLS form.

Most examples of calling system services use the CALLS form through the predefined macro for each service ($QIOW_S for $QIOW). There are two other macros, though, that can be used for the CALLG form. To build the argument list in a data section, there is a macro for each system service that has no _S of _G ending – $QIOW for $QIOW. This macro expands into storage for the argument list and defines offsets for each argument. It is used much as the _S macros which are usually used except that it does not generate any executable instructions, only storage directives. For example, let’s look at the $SETPRN system service:

ARGS:    $SETPRN PRCNAM=10$
10$:     .ASCID /Process Name/

expands to

ARGS:    .LONG 1          ; One argument
         .ADDRESS 10$     ; Descriptor address
10$:     .ASCID /Process Name/

We could now reference the argument as ARGS+SETPRN$_PRCNAM. The code for the actual call would look like the following string:

 $SETPRN_G ARGS

This would expand to the following:

 CALLG ARGS,G^SYS$SETPRN

For the Run-Time Library (RTL) routines, I had to manually build the argument lists; there are no macros for them.

Defining logicals and symbols

The primary purpose of virtually all login command procedures is to define logicals and symbols to customize the DCL command environment. By using logicals, you can reduce long directory and file specifications to a single letter, if desired; with symbols, you can reduce lengthy commands to a single letter and set up command defaults that differ from DEC’s defaults. Logical definition and symbol assignment at the DCL level are handled via internal DCL routines – there is no image activation required. When you enter a DEFINE command, DCL parses the command, determines that it can handle it without an image activation, and calls an internal subroutine to define the logical.

DEC has provided two RTL routines that can be called from a program to define symbols and logicals, LIB$SET_SYMBOL and LIB$SET_LOGICAL. When called from a program, both routines simply call back to DCL’s internal subroutine to perform the definitions. The DCL action doesn’t change, except that it no longer has to parse the command line to determine the command and its parameters.

LIB$SET_LOGICAL

The RTL routine LIB$SET_LOGICAL accepts two parameters – the address of the descriptor of the logical name to define and the descriptor address of the logical’s equivalence string. The logical is defined in supervisor mode (the default DCL mode) in the process logical name table (LNM$PROCESS). On the surface, there would seem to be no reason that a program couldn’t call the $CRELNM system service to create the logical. The problem arises when you try to define the logical from user mode – user mode logicals disappear as part of image rundown. A program would have to be executing in executive mode to define a logical that would stick around after image termination. LIB$SET_LOGICAL provides a clean way to define a logical just as DCL does.

LIB$SET_SYMBOL

The RTL routine LIB$SET_SYMBOL accepts three parameters – the descriptor address of the symbol name, the descriptor address of the symbol’s equivalence string, and the ID of the symbol table in which the symbol is defined. There are two symbol tables for a process – the local symbol table (temporary symbols) and the global symbol table (existing for the life of the process, unless deleted). All of the symbols defined by Program 1 are set in the global symbol table, which is the same as using the double equal signs at the DCL prompt (SYMBOL :== EQUIV).

LOGIN symbols and logicals

All of the logicals and symbols to be defined by LOGIN are stored as part of the image itself. I decided to optimize for disk space, so each pair of strings is stored as counted ASCII strings (.ASCIC). The code then steps through the list of logicals and symbols, changing two static descriptors, and calling the RTL routines to make the definitions. The code loops until it encounters the null longword stored at the end of each list.

The two lists of logicals and symbols and their equivalence strings are stored at the locations denoted by the labels LOGICALS and SYMBOLS in Program 1. For each pair of strings, a macro is used to set up the .ASCIC buffers for each pair. The macros, SYM and LOG, are functionally equivalent; I used two macros simply to make it easier to tell which were symbols and which were logicals. SYM and LOG accept as parameters the name to define and the equivalence string for the name. To add logical and symbol definitions to LOGIN.MAR, simply add a line between the appropriate label and the .LONG assembly directive following each list, as shown below:

 $ DEFINE HOME DUA1:[AC012116] --> LOG HOME DUA1:[AC012116]
 $ COPY :== COPY/LOG --> SYM COPY COPY/LOG
 $ TPU :== ATTACH MY_EVE --> SYM CLOCK <ATTACH MY_EVE>

In the last example, the angle brackets (<>) are needed to tell the SYM macro that the two words form one argument (the EQUIV parameter).

Miscellaneous tasks

Other tasks often performed by login command files are the setting of process names, privileges, etc. DCL commands such as SET PROCESS cause an image activation; the image then calls a system service to perform the task at hand. I took a few of the more common login commands and found their corresponding system services which are called directly from LOGIN.MAR.

$SETPRV system service

The DCL command SET PROCESS/PRIVILEGE invokes a call to the $SETPRV system service to enable or disable privileges. $SETPRV accepts three input parameters – the address of a quadword whose set bits determine the privileges affected, a flag indicating whether the privileges are to be enabled or disabled, and a flag to indicate whether or not the effect is permanent. The quadword privilege mask may be defined using the .QUAD assembly directive and the PRV$ symbols defined by the system macro $PRVDEF. In LOGIN.MAR, label PRIVS: points to the argument list for the call to $SETPRV. The privilege masks are OR’ed together with the OR assembler notation (“!”). To change the mask, simply add or remove the proper PRV$M_ symbol from the list.

$SETPRI

The $SETPRI system service is called to change the priority of the current process. To raise your priority above the base priority established for your process in SYSUAF.DAT, you must have the ALTPRI privilege. While it is not usually good policy to raise your priority (at the very least, other users get mad!), I have included it as an example. $SETPRI takes the priority level as its single parameter (see PRIORITY: in LOGIN.MAR).

SYS$SETDFPROT

The system service SYS$SETDFPROT may be called to establish a default RMS protection to be applied to all files created during a session. Its corresponding DCL command is SET PROTECTION/DEFAULT. It accepts the default mask (if you wish to change it) and optionally returns the old protection mask. LOGIN sets the default RMS protection to SYSTEM and OWNER RWED and to no access for GROUP and WORLD (see DEFPROT: in LOGIN.MAR).

$SETPRN system service

$SETPRN is called to set your process name (equivalent to SET PROCESS/NAME). It accepts a single parameter – the name for the process. Calling $SETPRN is more flexible than using the DCL command because any sequence of characters can be used in the process name. In the internal subroutine SET_PROCESS_NAME, LOGIN will set a process name for up to four logins (if you log in from 4 terminals at once, each process will have a name that you determine). When a process name is already in use in your group, $SETPRN returns with an error; LOGIN simply calls $SETPRN repeatedly until the process name is successfully set (the low bit of R0 is set). The number of different names that can be set is flexible; simply add names to the data section containing PRCNAM1 through PRCNAM4 and add instructions to routine SET_PROCESS_NAME.

RTL routine LIB$ENABLE_CTRL

The DCL command SET CONTROL has a corresponding RTL routine, LIB$ENABLE_CTRL. This routine does the same thing that LIB$SET_LOGICAL and LIB$SET_SYMBOL do – it calls back to DCL to enable DCL’s trapping of control characters (currently only CTRL-T and CTRL-Y are trapped by DCL). The routine accepts a longword mask whose set bits indicate which control characters are to be enabled (see CTRLMSK: in LOGIN.MAR). LOGIN’s call performs the same function as the command string $ SET CONTROL=(T,Y). There is a corresponding routine LIB$DISABLE_CTRL to disable DCL recognition of these control characters.

Setting terminal characteristics using $QIO

Since the default terminal characteristics defined with SYSGEN are rarely set the way I want, I have LOGIN use the $QIO system service to change the characteristics and to write escape sequences to the terminal to reset a number of the physical setups. The internal subroutine SET_TT_CHARS is functionally equivalent to the DCL command SET TERMINAL.

SET_TT_CHARS first opens an I/O channel to the terminal (SYS$COMMAND) using the $ASSIGN system service. Once the channel has been established, it uses the $QIO function IO$_SENSEMODE to read the current terminal characteristics. IO$_SENSEMODE returns the characteristics in a 12-byte buffer. Offsets into the basic terminal and extended terminal characteristics longwords are defined in the system macros $TTDEF and $TT2DEF. Once the $QIO completes and the terminal characteristics have been returned, certain bits are cleared and set in the longwords using the BICL2 and BISL2 instructions. In addition, the terminal device type is set as a VT200 series terminal. The modified characteristics are then set by calling the $QIO system service again, this time with the function code IO$_SETMODE. This function code modifies the terminal characteristics for only the current interactive session.

Now that the terminal characteristics are set as VMS sees the terminal, I have SET_TT_CHARS write an escape sequence to the terminal to reset certain physical setups, such as turning on the cursor, setting the device type, and resetting the video attributes. This escape sequence is defined at label SET_APP_KEYPAD and can be modified for other terminal specific sequences. Finally, the I/O channel assigned to SYS$COMMAND is dropped using the $DASSGN system service.

PRINT_DATE subroutine

When I log in, I like to see the current date and time. I’m sure you’ll agree that the format displayed by SHOW TIME is adequate, though hardly “pretty.” I wrote the subroutine PRINT_DATE to print the date and time in a more useful format. PRINT_DATE calls the $NUMTIM system service to get the numeric date and time and builds an argument list for an $FAO (Formatted ASCII Output) call to build the time display. RTL routine LIB$PUT_OUTPUT is then used to print the final result.

A MACRO note: $NUMTIM returns the numeric date in a 7-word structure, where each word holds a different part of the date and time – the year, the month number, etc. I used the $DEFINI macro to build symbolic offsets for each of the seven words in the structure so that I could use symbols instead of numeric offsets when accessing the various pieces of the structure. The $DEFINI macro is located in the default system macro library, SYS$LIBRARY:STARLET.MLB, and is very useful for defining structures in MACRO.

Kernel mode DCL stuff

The last routine in LOGIN is SET_DCL_STUFF. It is last because most people will probably not be able to use it. SET_DCL_STUFF changes to kernel mode to tweak some DCL locations in P1 space to have the same effect as some frequently used DCL commands. The commands replaced here are SET MESSAGE, SET NOVERIFY, and SET PROMPT.

If you do not have CMKRNL privilege, this routine will be useless to you. (If you wanted to use LOGIN as a system-wide login program, and all users wanted the same setup, LOGIN could be installed with CMKRNL privilege.) All CTL$ symbols described below are defined in the symbol table SYS$SYSTEM:SYS.STB; the PRC symbols are defined in SYS$SYSTEM:DCLDEF.STB.

SET MESSAGE

The command SET MESSAGE is used to affect the amount of information displayed when error messages are printed. By default, all error messages contain a FACILITY code, a SEVERITY code, an error IDENTIFICATION code, and the TEXT of the error message as shown in the example below:

 %DCL-I-SUPERSEDE, previous value of ... has been superseded

There is a mask (one byte) located in each process’s P1 space at global location CTL$GB_MSGMASK that determines which pieces of information are to be shown. LOGIN sets this mask to 1, which is equivalent to turning off all parts but the text of the message:

 Previous value of ... has been superseded

I prefer seeing the cleaner error messages to seeing the percent sign followed by extra text. If I need to see it all, I’ll simply turn them back on.

SET NOVERIFY and SET PROMPT

The beginning of a process’s P1 address region that can be used as a storage and work area by a CLI is pointed to by the system-wide global symbol CTL$AG_CLIDATA. DCL defines offsets from this address that point to other process-dependent information, including the address of the process work area (at offset CTL$AG_CLIDATA+PPD$L_PRC). DCL stores the command recall buffer, the prompt, symbol and keypad definitions, etc., in the process work area. One word in the PRC region is used to store flags relevant to command procedure execution and another buffer is used for the prompt. The following MACRO code shows how to load the address of the PRC area into register 6:

      MOVAL   G^CTL$AG_CLIDATA,R6       ; Get address of CLI data
      MOVL    PPD$L_PRC(R6),R6          ; Get PRC area address

The flag indicating whether or not VERIFY is enabled is stored at PRC offset PRC_W_FLAGS. If bit PRC_V_VERIFY is clear in PRC_W_FLAGS, then verify is disabled. LOGIN clears this bit using BICW2 and the mask PRC_M_VERIFY.

SET PROMPT

The DCL prompt is stored in the PRC region at offset PRC_G_PROMPT and its length is stored at offset PRC_B_PROMPTLEN. To change the prompt, LOGIN simply moves the character string described by the descriptor at label PROMPT to offset PRC_G_PROMPT. The length of the new prompt is added to 3 and the final result is placed in the byte at offset PRC_B_PROMPTLEN. The length must be added to 3 because DCL counts the default carriage-return, line-feed, and continuation character (_) as part of the total length of the prompt. The maximum length that a prompt can be is 32 characters (plus the 3 additional characters). Any prompt you give that is longer than 32 characters will write over other data in your process space and could cause your process to die.

For the sake of example, SET_DCL_STUFF makes a call to the RMS/system service SYS$SETDDIR to get the current default directory specification to use as the DCL prompt. This is equivalent to the following DCL command:

 $ SET PROMPT='F$DIRECTORY()'

You can set a specific prompt by removing the CALLG instruction and changing PROMPT: so that it describes your prompt string.

LOGIN Details

The flow of control for LOGIN begins at the entry point (.ENTRY). I have broken up the pieces of LOGIN into internal subroutines to make the structure and flow easier to see. Each subroutine is executed using the BSBW (branch to subroutine with word offset) instruction; after the routine executes, control is returned to the next BSBW instruction. The order in which the routines are executed can be changed by simply changing the order of the BSBW instructions. Another benefit of using the CALLG format for calling the RTL routines and the system services is that they can easily be moved to another routine or removed from the program.

Interactive and Batch Processes

The first thing LOGIN does is call the $GETJPI (Get Job/Process Information) system service to get the mode of the executing process. The call completes asynchronously so LOGIN can proceed with certain functions. Once LOGIN has performed all tasks for any type of process, it waits for $GETJPI to complete (if necessary) and then checks the mode of the process. If the process is not an interactive process, LOGIN exits to VMS without doing such things as setting the terminal characteristics (since there is no terminal for a batch job!). If the process is interactive, LOGIN will set the terminal characteristics and the process name before returning to VMS.

Register Usage and Errors

Most of the subroutines use registers 0-5 for whatever purpose they want without saving and restoring the contents before using them. Any errors returned by the external routines are ignored (like using SET NOON); if it doesn’t work, it doesn’t work! Since I was aware of what the routines would be doing, I decided not to depend on the contents of the registers, etc.

Routine KRNL_HANDLER

If properly linked, it’s doubtful that the kernel mode portion of SET_DCL_STUFF will encounter any nasty problems like access violations that would crash the system. For safety’s sake, I added KRNL_HANDLER, a kernel mode condition handler that will trap access violations and safely return an error status to the caller of the $CMKRNL system service instead of crashing the system. Much better than having the system die unexpectedly!

Other possibilities

The possibilities for LOGIN are virtually limitless. Anything could be added to make the program smarter or perform more functions. Ideas include:

  • Calling $GETJPI to determine how many times you’re logged in and printing a message informing you of the number (“You are logged in on X other terminals”).
  • Changing your default directory so that you are in a subprocess of your home directory (included as routine SET_DEFAULT).
  • Defining certain symbols and logicals specifically for batch jobs.
  • Performing certain functions if your terminal’s baud rate is 1200 or 2400 (dialed into the system through a modem).

Of course, my DCL key definition routines from my previous article can be used here as well.

Building LOGIN.EXE

To build the LOGIN program, use a text editor to tailor it to your wants and needs and execute the following commands:

 $ MACRO LOGIN
 $ LINK LOGIN
 $ RUN LOGIN

Then simply change your LOGIN.COM so that it executes LOGIN.EXE and any other things that simply cannot be done from LOGIN.EXE (executing other programs, etc.):

 $ ! Sample LOGIN.COM
 $ RUN SYS$LOGIN:LOGIN.EXE
 $ EXIT

Again, Program 1 is the MACRO source for LOGIN. Program 2 is a LOGIN command procedure that provides the same functionality. You will notice that running LOGIN.EXE requires one image activation, compared to at least 6 image activations in the LOGIN.COM. Then you have the overhead DCL incurs when it parses each command… I have attempted to provide a MACRO program that can be easily modified by people who don’t know much about the language and program structure. The comments in LOGIN should tell you anything I have neglected to mention here. Try it out – I think you’ll find that it is significantly faster than the old, boring LOGIN.COM!

Biographical Information:

Hunter Goatley, a graduate in Computer Science from Western Kentucky University, is currently working as a programmer/analyst for Clyde Digital Systems, Orem, Utah.

 


LOGIN.COM

$ !
$ !  Author:    Hunter Goatley
$ !  File:      LOGIN.COM functionally equivalent to program presented as
$ !             Program 1 (for the most part).
$ !
$ SET NOON                                      !Ignore any errors
$ !
$ DEFINE/NOLOG DBG$INIT         H:DBGINI.DBG
$ DEFINE/NOLOG EDTINI           H:EDTINI.EDT
$ DEFINE/NOLOG MAIL$INIT        H:MAIL$INIT.INI
$ DEFINE/NOLOG MAIL$EDIT        CALLABLE_TPU
$ DEFINE/NOLOG TPU$CALLUSER     ATE:TPU_AUTOSAVE.EXE
$ DEFINE/NOLOG TPUSECINI        ATE:CDS_EVE.TPU$SECTION
$ DEFINE/NOLOG H                RD$USER:[WHG.HUNTER]
$ DEFINE/NOLOG MAR              RD$USER:[WHG.MAR]
$ DEFINE/NOLOG WKU$SPELL        AT$ROOT:[DATA]
$
$ AUDIT         :== $CLYDE$ROOT:[EXE]AUDIT.EXE  ! Clyde's AUDIT
$ KBLOCK        :== $CLYDE$ROOT:[EXE]KBLOCK.EXE ! Clyde's KBLock
$ CMD           :== $H:CMD.EXE                  ! Mess with DCL commands
$ COMPRESS      :== H:LZCMP.EXE                 ! DECUS LZW file compression
$ DECOMPRESS    :== H:LZDCM.EXE                 ! DECUS LZW file decompression
$ DETAB         :== $H:DETAB.EXE                ! Replace TABs w/ blanks
$ ENTAB         :== $H:ENTAB.EXE                ! Replace blanks with tabs
$ EVESPN        :== @H:EVE.COM SPAWN            ! Spawn EVE process
$ FLIST         :== $ATE:FLIST.EXE              ! FLIST directory manager
$ GETCMD        :== $H:GETCMD.EXE               ! Get another user's DCL cmds
$ INSTALL       :== $INSTALL/COMMAND            ! INSTALL utility
$ LO*GOUT       :== @H:LOGOUT.COM               ! Logout
$ LOGIN         :== $H:LOGIN.EXE                ! Execute LOGIN.EXE
$ REM*IND       :== $ATE:REMIND.EXE             ! My REMINDer
$ SD            :== $H:SD.EXE                   ! Set default
$ WKUMON        :== $H:WKUMON.EXE               ! Process monitor program
$ !
$ SET PROTECTION=(S:RWED,O:RWED,G,W)/DEFAULT    !Set our default RMS protection
$ !
$ ! Both SET PROCESS/PRIVILEGE and SET PROCESS/PRIORITY require image
$ ! activations.
$ !
$ SET PROCESS/PRIVILEGE=(SYSPRV,WORLD,OPER,EXQUOTA)     !Turn on some privileges
$ SET PROCESS/PRIORITY=5                        !Set up our priority
$ SET CONTROL=(Y,T)                             !Enable ^T and ^Y
$
$ SHOW TIME                                     !Not the same as mine!
$
$ if f$mode() .nes. "INTERACTIVE" then $ EXIT   !Exit unless we're interactive
$ !
$ !  Each of the following SET PROCESS/NAME commands requires an image
$ !  activation.
$ !
$ SET PROCESS/NAME="Goat Hunter"                ! If we're not already logged
$ SET PROCESS/NAME="Goat Story"                 ! ... in, these will succeed
$ SET PROCESS/NAME="Goat Busters"               ! ... until the last executes
$ SET PROCESS/NAME="Polter Goat"                ! ...
$ !
$ !  The SET TERMINAL and SET MESSAGE commands both require image activations.
$ !
$ SET TERMINAL/DEVICE=VT200/EDIT/WRAP/BROADCAST/TAB/APPLICATION
$ ESC[0,31] = 27
$ SO[0,31] = 15
$ WRITE SYS$OUTPUT ESC,"[m",ESC,"(B",ESC,")B",ESC,"[62;1""p",ESC,"[?25h", -
ESC,"[4l",ESC,"=",SO
$ !
$ SET NOVERIFY
$ SET MESSAGE/TEXT/NOFACILITY/NOSEVERITY/NOIDENTIFICATION
$ SET PROMPT='F$DIRECTORY()'
$ EXIT

LOGIN.MAR

Download LOGIN.MAR

        .TITLE  LOGIN - Set up environment at LOGIN
        .IDENT  /01-001/
;========================================================================
;=                                                                      =
;=      Program:        LOGIN.MAR                                       =
;=                                                                      =
;=      Programmer:     Hunter Goatley                                  =
;=                      Clyde Digital Systems                           =
;=                      371 East 800 South                              =
;=                      Orem, Utah  84058                               =
;=                      (801) 224-5306                                  =
;=                                                                      =
;=      Date:           March 13, 1988                                  =
;=                                                                      =
;=      Purpose:        Define logicals and foreign commands and other  =
;=                      miscellaneous things at login.                  =
;=                                                                      =
;========================================================================
;=                                                                      =
;=      This program was written to be called from a LOGIN.COM to       =
;=      define logicals, global symbols,  and  do other things at       =
;=      login.  It  is  substantially  faster than  a DCL command       =
;=      procedure that does the same things.                            =
;=                                                                      =
;========================================================================
;
        .PAGE
        .SBTTL  Macro and symbol definitions
;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
        .LINK   /SYS$SYSTEM:DCLDEF.STB/         ; Link to DCL's symbol table
        .LINK   /SYS$SYSTEM:SYS.STB/            ; Link to system symbol table
;
;  Define all symbols used in this program.
;
        $SSDEF                                  ; System service symbols
        $PRVDEF                                 ; Privilege mask symbols
        $LIBDEF                                 ; RTL symbols
        $JPIDEF                                 ; $GETJPI symbols
        $IODEF                                  ; I/O function codes
        $DSCDEF                                 ; Descriptor symbols
        $TTDEF                                  ; Terminal characteristic
        $TT2DEF                                 ; ...  symbols
        $CHFDEF                                 ; Condition Handler symbols
;
;  Define symbolic offsets for the 7 word array returned by the system service
;  $NUMTIM.
;
        $DEFINI TIM                             ; Structure for $NUMTIM buffer
$DEF    TIM_W_YEAR      .BLKW   1               ; 7 words:      Year
$DEF    TIM_W_MONTH     .BLKW   1               ; ....          Month
$DEF    TIM_W_DAY       .BLKW   1               ; ....          Day
$DEF    TIM_W_HOUR      .BLKW   1               ; ....          Hour
$DEF    TIM_W_MINUTE    .BLKW   1               ; ....          Minute
$DEF    TIM_W_SECOND    .BLKW   1               ; ....          Second
$DEF    TIM_W_HUNDRED   .BLKW   1               ; ....          Hundredths
        $DEFEND TIM
;+
;  Macro:       BUILD_DESCS
;
;  Purpose:
;
;       This macro is used to set up the descriptors for setting symbols and
;       defining logicals.
;
;  Implicit inputs:
;
;       R2 - Address of descriptor for the equivalence strings
;       R3 - Address of descriptor for the symbol/logical strings
;       R4 - Address of next .ASCIC symbol/equivalence pair
;
;  Work register:
;
;       R0 - Used for temporary storage of the length of each string
;-
        .MACRO  BUILD_DESCS
        MOVZBL  (R4)+,R0                ; Get the string length
        MOVW    R0,(R2)                 ; Put it in the descriptor
        MOVL    R4,4(R2)                ; Set up the address too
        ADDL2   R0,R4                   ; Add to get addr of next string
                                        ;
        MOVZBL  (R4)+,R0                ; Get the string length
        MOVW    R0,(R3)                 ; Put it in the descriptor
        MOVL    R4,4(R3)                ; Set up the address too
        ADDL2   R0,R4                   ; Add to get addr of next string
                                        ;
        .ENDM   BUILD_DESCS

;+
;
;  Macro:       SYM & LOG
;
;  Input:       Logical/Symbol name and equivalence string
;
;  Purpose:
;
;       Build .ASCIC string for each pair of strings.
;
;       Using .ASCIC (as opposed to .ASCID) saves 14 bytes of memory
;       for each pair of strings.  This savings of memory makes the
;       extra instructions worth using.  The CPU instructions move the
;       count and address for each string to two descriptors for the
;       Run-Time Library calls.
;
;-
;
        .MACRO  SYM     SYMBOL,EQUIV
        .ASCIC  ?EQUIV?                         ; The symbol's equivalence str
        .ASCIC  ?SYMBOL?                        ; The symbol name
        .ENDM   SYM

        .MACRO  LOG     LOGICAL,EQUIV
        .ASCIC  ?EQUIV?                         ; The logical's equivalence str
        .ASCIC  ?LOGICAL?                       ; The logical name
        .ENDM   LOG

        .PAGE
        .SBTTL  Data storage for LOGIN

        .PSECT  _LOGIN_DATA,LONG,NOEXE,WRT
;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
;
;======  The descriptor to be used for all equivalence strings (for both
;======  logicals and symbols)(LIB$SET_LOGICAL & LIB$SET_SYMBOL expect
;======  parameters to be passed by descriptor)
;
EQUIV_DESC:
                .WORD   0                       ; Soon to be the string length
                .BYTE   DSC$K_DTYPE_T           ; The type of string (character)
                .BYTE   DSC$K_CLASS_S           ; The class (static)
                .LONG   0                       ; Soon to be the address
;
;=====  The descriptor to be used for all logical names and symbol names
;=====  to be defined
;
SYM_LOG_DESC:
                .WORD   0                       ; Soon to be the string length
                .BYTE   DSC$K_DTYPE_T           ; The type of string (character)
                .BYTE   DSC$K_CLASS_S           ; The class (static)
                .LONG   0                       ; Soon to be the address
;
;  Argument list for call to RTL routine LIB$SET_LOGICAL
;
LOG_ARGS:       .LONG   2                       ; LIB$SET_LOGICAL takes 2 args
                .ADDRESS SYM_LOG_DESC           ; ... The logical to define
                .ADDRESS EQUIV_DESC             ; ... The equivalence value
;
;  Argument list for call to RTL routine LIB$SET_SYMBOL
;
;  All symbols are defined in the global symbol table (equivalent to using
;  the double equal signs at DCL - ":==").
;
SYM_ARGS:       .LONG   3                       ; LIB$SET_SYMBOL argument list
                .ADDRESS SYM_LOG_DESC           ; ... The symbol to set
                .ADDRESS EQUIV_DESC             ; ... The equivalence string
                .ADDRESS 10$                    ; ... The symbol table
        10$:    .LONG   LIB$K_CLI_GLOBAL_SYM    ; Global symbol table-id

        .PAGE
        .SBTTL  Process logicals table
;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
;=====  The logicals to define
;
LOGICALS:

LOG     DBG$INIT        H:DBGINI.DBG
LOG     EDTINI          H:EDTINI.EDT
LOG     MAIL$INIT       H:MAIL$INIT.INI
LOG     MAIL$EDIT       CALLABLE_TPU
LOG     TPU$CALLUSER    ATE:TPU_AUTOSAVE.EXE
LOG     TPUSECINI       ATE:CDS_EVE.TPU$SECTION
LOG     H               RD$USER:[WHG.HUNTER]
LOG     MAR             RD$USER:[WHG.MAR]
LOG     WKU$SPELL       AT$ROOT:[DATA]

        .LONG   0       ; End of logicals table

        .PAGE
        .SBTTL  Global process symbols table
;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
;=====  The symbols to define
;
        .ALIGN  LONG
SYMBOLS:

SYM     AUDIT           $CLYDE$ROOT:[EXE]AUDIT.EXE      ; Clyde's AUDIT
SYM     KBLOCK          $CLYDE$ROOT:[EXE]KBLOCK.EXE     ; Clyde's KBLock
SYM     CMD             $H:CMD.EXE              ; Mess with DCL commands
SYM     COMPRESS        $H:LZCMP.EXE            ; DECUS LZW file compression
SYM     DECOMPRESS      $H:LZDCM.EXE            ; DECUS LZW file decompression
SYM     DETAB           $H:DETAB.EXE            ; Replace TABs w/ blanks
SYM     ENTAB           $H:ENTAB.EXE            ; Replace blanks with tabs
SYM     EVESPN          <@H:EVE.COM SPAWN>      ; Spawn EVE process
SYM     FLIST           $ATE:FLIST.EXE          ; FLIST directory manager
SYM     GETCMD          $H:GETCMD.EXE           ; Get another user's DCL cmds
SYM     INSTALL         $INSTALL/COMMAND        ; INSTALL utility
SYM     LO*GOUT         @H:LOGOUT.COM           ; Logout
SYM     LOGIN           $H:LOGIN.EXE            ; Execute LOGIN.EXE
SYM     REM*IND         $ATE:REMIND.EXE         ; My REMINDer
SYM     SD              $H:SD.EXE               ; Set default
SYM     WKUMON          $H:WKUMON.EXE           ; Process monitor program

        .LONG   0       ; End of symbols table

        .PAGE
        .SBTTL  PRINT_DATE data
;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
NUMTIM_ARGS:    $NUMTIM TIMBUF=NUMTIMBUF        ; Argument list for $NUMTIM
;
;  $FAO control string for "pretty" format date and time.  Example:
;
;               Saturday, May 7, 1988  9:29:00 AM
;
FAO_TIME:       .ASCID  \!/!AC, !AC !UB, !UW  !UB:!2ZB:!2ZB !AC!/\

;
;==  The day names to be used to show the date & time.  The weekday number
;==  returned by LIB$DAY_OF_WEEK is used as an index into this vector table
;==  to get the address of the proper weekday string.
;
        .ALIGN  LONG
DAYS:           .ADDRESS 10$                    ; Day 1 - Monday
                .ADDRESS 20$                    ; Day 2 - Tuesday
                .ADDRESS 30$                    ; Day 3 - Wednesday
                .ADDRESS 40$                    ; Day 4 - Thursday
                .ADDRESS 50$                    ; Day 5 - Friday
                .ADDRESS 60$                    ; Day 6 - Saturday
                .ADDRESS 70$                    ; Day 7 - Sunday
        10$:    .ASCIC  /Monday/
        20$:    .ASCIC  /Tuesday/
        30$:    .ASCIC  /Wednesday/
        40$:    .ASCIC  /Thursday/
        50$:    .ASCIC  /Friday/
        60$:    .ASCIC  /Saturday/
        70$:    .ASCIC  /Sunday/
;
;==  The month names to be used to show the date & time.  The month returned
;==  by $NUMTIM is used as an index into this vector table to get the address
;==  of the month name.
;
        .ALIGN  LONG
MONTHS:         .ADDRESS 10$                    ; January
                .ADDRESS 20$                    ; February
                .ADDRESS 30$                    ; March
                .ADDRESS 40$                    ; April
                .ADDRESS 50$                    ; May
                .ADDRESS 60$                    ; June
                .ADDRESS 70$                    ; July
                .ADDRESS 80$                    ; August
                .ADDRESS 90$                    ; September
                .ADDRESS 100$                   ; October
                .ADDRESS 110$                   ; November
                .ADDRESS 120$                   ; December
         10$:   .ASCIC  /January/
         20$:   .ASCIC  /February/
         30$:   .ASCIC  /March/
         40$:   .ASCIC  /April/
         50$:   .ASCIC  /May/
         60$:   .ASCIC  /June/
         70$:   .ASCIC  /July/
         80$:   .ASCIC  /August/
         90$:   .ASCIC  /September/
        100$:   .ASCIC  /October/
        110$:   .ASCIC  /November/
        120$:   .ASCIC  /December/

AM:             .ASCIC  /AM/                    ; Ante meridiem
PM:             .ASCIC  /PM/                    ; Post meridiem
                                                ;
NUMTIMBUF:      .BLKW   7                       ; Buffer for numeric time
                                                ; ...  returned by $NUMTIM
                                                ;
FAO_ARGS:       $FAO    CTRSTR=FAO_TIME, -      ; $FAO argument list for date
                        OUTBUF=FAO_OUT, -       ; ...  Output buffer is FAO_OUT
                        OUTLEN=FAO_OUT, -       ; ...  Write final length there
                        P1=0, -                 ; ...  Will point to weekday
                        P2=0, -                 ; ...  Will point to month
                        P3=0, -                 ; ...  Will point to day
                        P4=0, -                 ; ...  Will point to year
                        P5=0, -                 ; ...  Will point to hour
                        P6=0, -                 ; ...  Will point to minutes
                        P7=0, -                 ; ...  Will point to seconds
                        P8=PM                   ; ...  Points to meridiem
                                                ;
FAO_OUT:        .WORD   256                     ; Output buffer (and descriptor)
                .BYTE   DSC$K_DTYPE_T           ; ... for formatted date and
                .BYTE   DSC$K_CLASS_S           ; ... time
                .ADDRESS .+4                    ; ...
                .BLKB   256                     ; ... The actual buffer
;

        .PAGE
        .SBTTL  SET_PROCESS_NAME data
;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
;==  The process names to set.
;
PRCNAM1:        $SETPRN PRCNAM=10$              ; $SETPRN argument list
        10$:    .ASCID  /Polter Goat/           ; ...  1st process name
                .ALIGN  LONG                    ; Align on longword boundary
PRCNAM2:        $SETPRN PRCNAM=10$              ; ...
        10$:    .ASCID  /Goat Busters/          ; ...  2nd process name
                .ALIGN  LONG                    ; Align on longword boundary
PRCNAM3:        $SETPRN PRCNAM=10$              ; ...
        10$:    .ASCID  /Goat Story/            ; ...  3rd process name
                .ALIGN  LONG                    ; Align on longword boundary
PRCNAM4:        $SETPRN PRCNAM=10$              ; ...
        10$:    .ASCID  /Goat Hunter/           ; ...  4th process name
                .ALIGN  LONG                    ; Align on longword boundary

        .SBTTL  $GETJPI data
;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
JPI_ARGS:       $GETJPI EFN=13, -               ; $GETJPI argument list
                        ITMLST=10$              ; ...
        10$:                                    ; Item list for $GETJPI call
                .WORD   4                       ; Length of buffer
                .WORD   JPI$_MODE               ; Asking for process mode
                .ADDRESS MODE                   ; Address of buffer
                .LONG   0                       ; Ignore length returned
                .LONG   JPI$C_LISTEND           ; End of JPI_LIST

MODE:           .BLKL   1                       ; Longword for mode indicator

JPI_WAIT:       $WAITFR EFN=13                  ; Wait for $GETJPI to finish

        .SBTTL  SET_TT_CHARS data
;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
ESC     = 27                                    ; Escape character - ASCII 27
SO      = 15                                    ; Shift Out - ASCII 15
TTCHAN:         .BLKL   1                       ; Holds I/O channel for TT:
TTCHARS:        .BLKB   12                      ; Buffer to hold characteristics
SET_APP_KEYPAD: .ASCII -                        ; ESC sequences to send to TT
                        /[m/ -             ;  Turn off video attributes
                        /(B/ -             ;  G0 designated as US set
                        /)B/ -             ;  Set G1 character set - ASCII
                        /[62;1"p/ -        ;  Set VT200, 7-bit mode
                        /[?25h/ -          ;  Cursor on
                        /[4l/ -            ;  Turn insert off
                        /[?7l/ -           ;  Turn auto-wrap off
                        /=/ -              ;  Set application keypad
                                            ;  Enable G1 character set
SET_APP_KEYPAD_L = . - SET_APP_KEYPAD           ; Length of escape sequence

ASSIGN_ARGS:    $ASSIGN CHAN=TTCHAN, -          ; $ASSIGN argument list
                        DEVNAM=10$              ; ...  Assign I/O channel to TT:
        10$:    .ASCID  /SYS$COMMAND:/          ; ...

WRITESEQ:       $QIOW   CHAN=0, -               ; $QIOW argument list to write
                        FUNC=IO$_WRITEVBLK, -   ; ...  escape sequence to
                        P1=SET_APP_KEYPAD, -    ; ...  the terminal
                        P2=SET_APP_KEYPAD_L     ; ...

SENSEMODE:      $QIOW   CHAN=0 -                ; Get current characteristics
                        FUNC=IO$_SENSEMODE -    ; ...  Function SENSEMODE
                        P1=TTCHARS -            ; ...  Characteristics buffer
                        P2=12                   ; ...  Length of buffer

SETMODE:        $QIOW   CHAN=0 -                ; Set the new characteristics
                        FUNC=IO$_SETMODE -      ; ...  Function SETMODE
                        P1=TTCHARS -            ; ...  Characteristics buffer
                        P2=12                   ; ...  Length of buffer

        .SBTTL  Miscellaneous data storage
;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
;  Argument list for SYS$SETDFPROT system service.  A set bit in the protection
;  mask indicates no access.
;
;  Fields =>  | world | group | owner | system |       4 bits for each
;
DEFPROT:        .LONG   2                       ; Argument list for SETDFPROT
                .ADDRESS 10$                    ; ...  Protection mask address
                .LONG   0                       ; ...  Don't care what old was
        10$:    .WORD   ^B1111111100000000      ; Default RMS file protection
                                                ;   (S:RWED,O:RWED,G,W)
                .ALIGN  LONG
PRIVS:          $SETPRV -                       ; Turn on a few privileges
                        ENBFLG=1, -             ; ...  Turn them on
                        PRVADR=10$, -           ; ...
                        PRMFLG=1                ; ...  Turn them on permanently
        10$:    .QUAD   -
<PRV$M_SYSPRV!PRV$M_WORLD!PRV$M_EXQUOTA! - PRV$M_GROUP!PRV$M_CMEXEC!PRV$M_OPER>

PRIORITY:       $SETPRI PRI=5                   ; Raise my priority to 5

CTRLMSK:        .LONG   1                       ; LIB$ENABLE_CTRL argument list
                .ADDRESS 10$                    ; ...  Address of control mask
        10$:    .LONG   LIB$M_CLI_CTRLT!LIB$M_CLI_CTRLY

        .SBTTL  Argument lists for changing default directory
;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
;
;  Argument list for call to SYS$SETDDIR to change our default directory.
;  Note that SYS$SETDDIR does not change the default device - to do that,
;  we must call LIB$SET_LOGICAL to redefine SYS$DISK.
;
SET_DDIR:       .LONG   3                       ; SYS$SETDDIR argument list
                .ADDRESS 10$                    ; ... Change default directory
                .LONG   0                       ; ... Don't care what old
                .LONG   0                       ; ...   default was

        10$:    .ASCID  /[WHG.WORK]/            ; New default directory
;
;  To specify the default directory, simply place the directory spec between
;  the two slashes (//) in line 10$ above.
;

SET_DDISK:      .LONG   2                       ; LIB$SET_LOGICAL argument list
                .ADDRESS 10$                    ; ... Logical to define
                .ADDRESS 20$                    ; ... Equivalence string
        10$:    .ASCID  /SYS$DISK/              ; The default disk logical
        20$:    .ASCID  /$USER:/                ; New default disk spec
        ;
        ;  *NOTE*       To change our default disk, we are calling RTL routine
        ;               LIB$SET_LOGICAL.  We could simply add the new default
        ;               disk definition to our LOGICALS table:
        ;
        ;                       LOG     SYS$DISK        $USER
;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
;  Argument list to get our default directory.  This is included as an example
;  of how to get the default directory and use it as our prompt.
;
GET_DDIR:       .LONG   3                       ; SYS$SETDDIR argument list
                .LONG   0                       ; ... We're not setting default
                .ADDRESS PROMPT                 ; ... Return the string and its
                .ADDRESS PROMPT                 ; ...   length to PROMPT

PROMPT:         .WORD   256                     ; Descriptor for buffer to
                .BYTE   DSC$K_DTYPE_T           ; ... receive our default
                .BYTE   DSC$K_CLASS_S           ; ... directory so that it can
                .ADDRESS .+4                    ; ... be used as our DCL
                .BLKB   256                     ; ... prompt.
;
;  To specify a certain prompt, you can delete the preceding lines and place
;  the prompt string between the two slashes (//) below.
;
;PROMPT:        .ASCID  /VAX> /                 ; Another prompt string

        .PAGE
        .SBTTL  LOGIN entry point - main routine
;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
;       M A I N   Routine
;
        .PSECT  _LOGIN_CODE,EXE,NOWRT,LONG,PIC,SHR
        .ENTRY  LOGIN,^M<R2,R3,R4,R5>
                                                ;
        $GETJPI_G -                             ; Get mode of process (batch,
                JPI_ARGS                        ; ...  interactive, etc.)
                                                ;
        BSBW    DEFINE_LOGICALS                 ; Go define all of our logicals
        BSBW    SET_SYMBOLS                     ; Go set all of our symbols
        BSBW    DO_MISCELLANEOUS                ; Go do other things
        BSBW    PRINT_DATE                      ; Go print date and time
                                                ;
        $WAITFR_G JPI_WAIT                      ; Wait for $GETJPI to finish
        CMPL    #JPI$K_INTERACTIVE,MODE         ; Is process interactive?
        BNEQU   10$                             ; No - exit now
                                                ;
        BSBW    SET_PROCESS_NAME                ; Go set our process name
        BSBW    SET_TT_CHARS                    ; Set terminal characteristics
                                                ;
        BSBW    SET_DCL_STUFF                   ; Go set DCL things (NOVERIFY)
                                                ; (requires CMKRNL to work)
 10$:   MOVL    #SS$_NORMAL,R0                  ; Return success to VMS
        RET                                     ; ...

        .PAGE
        .SBTTL  DEFINE_LOGICALS subroutine
;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
;  Subroutine:  DEFINE_LOGICALS
;
;  Purpose:     Define all process logicals.
;
;  Inputs:      LOGICALS, EQUIV_DESC, SYM_LOG_DESC, and LOG_ARGS
;
DEFINE_LOGICALS:
        MOVAB   LOGICALS,R4                     ; Get address of first logical
        MOVAQ   EQUIV_DESC,R2                   ; EQUIVALENCE descriptor address
        MOVAQ   SYM_LOG_DESC,R3                 ; LOGICAL descriptor address
        MOVAL   LOG_ARGS,R5                     ; Move the argument list address
                                                ; ... to register for efficiency
 10$:   TSTB    (R4)                            ; Are we finished (0 length)?
        BEQLU   20$                             ; Yes -- leave
        BUILD_DESCS                             ; Build the descriptors
        CALLG   (R5),G^LIB$SET_LOGICAL          ; Go define the logical
        BRB     10$                             ; Loop until no more logicals
 20$:   RSB                                     ; Return to our caller

        .PAGE
        .SBTTL  SET_SYMBOLS subroutine
;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
;  Subroutine:  SET_SYMBOLS
;
;  Purpose:     Set all global process symbols.
;
;  Inputs:      LOGICALS, EQUIV_DESC, SYM_LOG_DESC, and SYM_ARGS
;
SET_SYMBOLS:
        MOVAQ   EQUIV_DESC,R2                   ; EQUIVALENCE descriptor address
        MOVAQ   SYM_LOG_DESC,R3                 ; LOGICAL descriptor address
        MOVAB   SYMBOLS,R4                      ; Get address of first symbol
        MOVAL   SYM_ARGS,R5                     ; Move the argument list address
                                                ; ... to register for efficiency
 10$:   TSTB    (R4)                            ; Are we finished (0 length)?
        BEQLU   20$                             ; Yes -- leave
        BUILD_DESCS                             ; Build the descriptors
        CALLG   (R5),G^LIB$SET_SYMBOL           ; Go set the symbol
        BRB     10$                             ; Loop until no more symbols
 20$:   RSB                                     ; Return to our caller

        .PAGE
        .SBTTL  PRINT_DATE subroutine
;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
;  Subroutine:  PRINT_DATE
;
;  Purpose:     Display the current date and time in a "pretty" format.
;
;  Inputs:      FAO_ARGS, NUMTIMBUF, NUMTIM_ARGS, MONTHS, DAYS, FAO_OUT
;
PRINT_DATE:
        $NUMTIM_G -                             ; Get the current time in
                NUMTIM_ARGS                     ; ... numeric format
        MOVAL   FAO_ARGS,R2                     ; Get address of FAO args list
        MOVAL   NUMTIMBUF,R3                    ; Get address of NUMTIM buffer
        CLRL    -(SP)                           ; Make space to receive weekday
        PUSHAL  (SP)                            ; Get the day of the week
        CLRL    -(SP)                           ; ... and put it on the stack
        CALLS   #2,G^LIB$DAY_OF_WEEK            ; ...
        POPL    R0                              ; Get the day of the week
        DECL    R0                              ; Make it point properly
        MOVL    DAYS[R0],FAO$_P1(R2)            ; Move address to $FAO arglst
        MOVZWL  TIM_W_MONTH(R3),R0              ; Get month number
        DECL    R0                              ; Make it point properly
        MOVL    MONTHS[R0],FAO$_P2(R2)          ; Move address to $FAO arglst
        MOVZWL  TIM_W_DAY(R3),FAO$_P3(R2)       ; Move DAY number into FAO list
        MOVZWL  TIM_W_YEAR(R3),FAO$_P4(R2)      ; Move YEAR into FAO arg list
        SUBW3   #12,TIM_W_HOUR(R3),FAO$_P5(R2)  ; Subtract 12 from hour in args
        BGTRU   10$                             ; Branch if > 0 (past noon - PM)
        MOVAB   AM,FAO$_P8(R2)                  ; Make it AM instead of PM
        ADDW2   #12,FAO$_P5(R2)                 ; Otherwise, add 12 back in!
        BNEQU   10$                             ; Branch if hour is not 0
        MOVW    #12,FAO$_P5(R2)                 ; Make the 0 hour midnight
10$:    MOVZWL  TIM_W_MINUTE(R3),FAO$_P6(R2)    ; Move minutes into FAO arg list
        MOVZWL  TIM_W_SECOND(R3),FAO$_P7(R2)    ; Move seconds into FAO arg list
        $FAO_G  FAO_ARGS                        ; Format the time
        PUSHAQ  FAO_OUT                         ; Print it to SYS$OUTPUT using
        CALLS   #1,G^LIB$PUT_OUTPUT             ; ...  RTL routine
        RSB                                     ; Return to our caller

        .PAGE
        .SBTTL  SET_TT_CHARS subroutine
;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
;  Subroutine:  SET_TT_CHARS
;
;  Purpose:     Set terminal characteristics for VT200.
;
;  Inputs:      ASSIGN_ARGS, SENSEMODE, SETMODE, WRITESEQ, TTCHAN, TTCHARS
;
SET_TT_CHARS:
        $ASSIGN_G ASSIGN_ARGS                   ; Assign I/O channel to TT:
        MOVW    TTCHAN,SENSEMODE+QIOW$_CHAN     ; Move I/O channel to QIO block
        MOVW    TTCHAN,SETMODE+QIOW$_CHAN       ; Move I/O channel to QIO block
        MOVW    TTCHAN,WRITESEQ+QIOW$_CHAN      ; Move I/O channel to QIO block
        $QIOW_G SENSEMODE                       ; Get current characteristics
        ;
        ;  Set new characteristics.  Equivalent to the following DCL command:
        ;
        ;       $ SET TERMINAL/BROADCAST/WRAP/TAB/ANSI/DECCRT/DECCRT2 -
        ;               /EDIT/LINE/APPLICATION
        ;
        BICL2   #TT$M_NOBRDCST,TTCHARS+4        ; Clear no broadcast bit
        BISL2   #<TT$M_WRAP!TT$M_MECHTAB>, -    ; Set WRAP and MECHTAB bits
                TTCHARS+4                       ; ... in basic chars longword
        BISL2   #<TT2$M_ANSICRT!TT2$M_DECCRT! - ; Set the rest of the chars
                TT2$M_DECCRT2!TT2$M_EDIT! -     ; ... in the extended chars
                TT2$M_APP_KEYPAD>, -            ; ... longword
                TTCHARS+8                       ; ...
        MOVB    #TT$_VT200_Series,TTCHARS+1     ; Set VT200 device type
        $QIOW_G SETMODE                         ; Set the new characteristics
        $QIOW_G WRITESEQ                        ; Write ESC sequence to TT:
        $DASSGN_S -                             ; Deassign terminal I/O channel
                CHAN=TTCHAN                     ; ...
        RSB                                     ; Return to our caller

        .PAGE
        .SBTTL  SET_PROCESS_NAME subroutine
;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
;  Subroutine:  SET_PROCESS_NAME
;
;  Purpose:     Set the process name.  If name is already used, select another
;               name.  Continue until success or no more names.
;
;  Inputs:      PRCNAM1, PRCNAM2, PRCNAM3, PRCNAM4
;
SET_PROCESS_NAME:
        $SETPRN_G PRCNAM1                       ; Set the process name
        BLBS    R0,10$                          ; Branch if successful
        ;
        ; If not successful, we're already logged in somewhere.  Try next name.
        ;
        $SETPRN_G PRCNAM2                       ; Set the 2nd process name
        BLBS    R0,10$                          ; Branch if successful
                                                ;
        $SETPRN_G PRCNAM3                       ; Set the 3rd process name
        BLBS    R0,10$                          ; Branch if successful
                                                ;
        $SETPRN_G PRCNAM4                       ; Set the 4th process name
 10$:   RSB                                     ; Return to our caller

        .PAGE
        .SBTTL  DO_MISCELLANEOUS subroutine
;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
;  Subroutine:  DO_MISCELLANEOUS
;
;  Purpose:     This routine performs the same function as the following DCL
;               commands:
;                       $ SET PROTECTION=(S:WRED,O:WRED,G,W)/DEFAULT
;                       $ SET PRIVILEGE=(privilege list)
;                       $ SET PRIORITY=5
;                       $ SET CONTROL=(T,Y)
;
;  Inputs:      PRCNAM1, PRCNAM2, PRCNAM3, PRCNAM4
;
DO_MISCELLANEOUS:
        CALLG   DEFPROT,G^SYS$SETDFPROT         ; Set the default RMS protection
        $SETPRV_G PRIVS                         ; Turn on more privileges
        $SETPRI_G PRIORITY                      ; Set up our priority
        CALLG   CTRLMSK,G^LIB$ENABLE_CTRL       ; Enable ^T and ^Y
        RSB                                     ; Return to caller

        .SBTTL  SET_DEFAULT subroutine
;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
;  Subroutine:  SET_DEFAULT
;
;  Purpose:     Change our default disk and directory.
;
;  Inputs:      SET_DDIR, SET_DDISK
;
SET_DEFAULT:
        CALLG   SET_DDIR,G^SYS$SETDDIR          ; Set our default directory
        CALLG   SET_DDISK,G^LIB$SET_LOGICAL     ; Change our default disk
        RSB                                     ; Return to our caller

        .PAGE
        .SBTTL  SET_DCL_STUFF subroutine
;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
;  Subroutine:  SET_DCL_STUFF
;
;  Purpose:     This routine performs the same functionality as the following
;               DCL commands:
;                               $ SET NOVERIFY
;                               $ SET MESSAGE/TEXT/NOIDENT/NOSEVERITY/NOFACILITY
;                               $ PROMPT = F$DIRECTORY()
;                               $ SET PROMPT='PROMPT'
;
;  *NOTE:       This routine must go into kernel mode to perform its tasks.
;               If you do not have CMKRNL privilege, you should not call this
;               routine (it will simply fail to work if you call it).
;
;               If you do not call this routine, you may remove the .LINK
;               assembler directives at the beginning of this program.
;
;  Inputs:      PROMPT
;
SET_DCL_STUFF:
        CALLG   GET_DDIR,G^SYS$SETDDIR          ; Get default directory to use
                                                ; ... as our prompt
        $CMKRNL_S -                             ; Need to go into kernel mode
                ROUTIN=10$                      ; ... to do this stuff
        RSB                                     ; Return to our caller

 10$:   .WORD   ^M<R2,R3,R4,R5,R6>              ; Entry mask - save registers
        MOVAL   KRNL_HANDLER,(FP)               ; Set up ACCVIO handler
                                                ;
        MOVB    #1,G^CTL$GB_MSGMASK             ; Set MESSAGE mask
                                                ;
        MOVAL   G^CTL$AG_CLIDATA,R6             ; Get address of CLI data in P1
        MOVL    PPD$L_PRC(R6),R6                ; Get address of PRC region
        BICW2   #PRC_M_VERIFY,PRC_W_FLAGS(R6)   ; Turn VERIFY off
                                                ;
        MOVAL   PROMPT,R0                       ; Get address of prompt
        ADDB3   #3,(R0),PRC_B_PROMPTLEN(R6)     ; Set length of prompt (need +3
                                                ; ... to count _)
        MOVC3   (R0),@4(R0),PRC_G_PROMPT(R6)    ; Move prompt into PRC region
                                                ;
        MOVL    #SS$_NORMAL,R0                  ; Return success
        RET                                     ; Return to caller

        .SBTTL  KRNL_HANDLER condition handler
;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
;  Routine:     KRNL_HANDLER
;
;  Purpose:     Kernel mode access violation handler.  Declaring this routine
;               as a condition handler for a kernel mode routine will prevent
;               the system from crashing if something goes wrong in the routine
;               (most likely an access violation).
;
;               If an access violation occurs, this routine gains control, sets
;               up call frame to return SS$_ACCVIO, and unwinds to the previous
;               caller.
;
        .ENTRY  KRNL_HANDLER,^M<>
        MOVL    CHF$L_MCHARGLST(AP),R0          ; Get mechanism array address
        CLRL    CHF$L_MCH_SAVR1(R0)             ; Clear saved R1 in array
        MOVL    #SS$_ACCVIO,CHF$L_MCH_SAVR0(R0) ; Put ACCVIO status in saved R0
        $UNWIND_S                               ; Unwind to previous caller
        RET                                     ; Return ACCVIO to caller

        .END    LOGIN

 Posted by at 9:43 am