.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 - 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 ; $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 #, - ; Set WRAP and MECHTAB bits TTCHARS+4 ; ... in basic chars longword BISL2 #, - ; ... 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 ; 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