From:	CRDGW2::CRDGW2::MRGATE::"SMTP::FALCON::TNIELAND" 13-JUN-1989 11:19
To:	MRGATE::"ARISIA::EVERHART"
Subj:	Idle times for SPC Version of VMS FINGER

Message-Id:  <8906131441.AA18245@crdgw1.ge.com>
Received: from FALCON by AAMRL.AF.MIL; Mon, 12 Jun 89 10:49 EDT
Date: Mon, 12 Jun 89 10:51 EST
From: Ted Nieland - SRL <@AAMRL.AF.MIL:TNIELAND@FALCON>
Subject: Idle times for SPC Version of VMS FINGER
To: terry%spcvxa.BITNET@MITVMA.MIT.EDU, everhart@arisia.decnet
X-Vms-To: IN%"terry@spcvxa.bitnet"

Attached is a VMS_SHARE file containing the needed material to implement Idle
times in FINGER.  The differences are with respect to the June 6 version of
FINGER.  Note:  I am one of the people who works on the SIG Tapes, therefore I
have copies of the material submitted for the SIG Tapes.  Also, Glenn Everhart
sent be the June 6 difference file for  FINGER that you had mailed to him. 


Please note the following:

The idle time code makes use of Joe Meadows' TERMINAL.MAR to check for the 
Idle Time in the UCB.  Normally this will not do any good for RTA and LTA 
terminals, but also included is IDLE-MON.MAR from Ken Adleman, which corrects 
the terminal drivers to get idle times for those remote devices.

The IDLE-MON.MAR is a program that is run at start up AFTER DECNet has been 
started, but BEFORE LAT is started.

One of the minor changes is moving where GET_LOCATION is called.  This is a 
necessary change for GET_IDLE.  GET_LOCATION returns the true physical 
terminal if you are using virtual terminals, and the physical terminal is
required by TERM_INFO.
 
Also, you will note that I have switched all the /CHECK qualifiers on the 
FORTRAN compilations back to /NOCHECK (as they were on the previous release).
This is required for the TCP/IP code to work correctly.   I do run WIN/TCP at 
this site and I found that /CHECK causes the TCP/IP to fail due to string 
checks failing.

I am currently running this code on a VAX 8650, a MVII, a VAX 11/780, and a 
MV 3200.  It should also run on multiprocessor machines.  The codes from 
Meadows and Adelman do run on Multiprocessor machines.



I am sending these changes to you for inclusion in the "definitive" FINGER.  
If you wish to have these changes included in the SIG Tape version, please 
notify Glenn Everhart (EVERHART%ARISIA.DECNET@CRD.GE.COM).  I am also sending 
Glenn a copy of these changes, but the submission is yours and he will need 
your permission to add the changes.

The files that have changed are:

FINGER.FOR  (difference file)
FINGER_BUILD.COM (new file)
INSTALL_FINGER.COM (new file)
TERMINAL.MAR (new file)
IDLE-MON.MAR (new file)


I am interested in your evaluation of these changes. Please let me know if you 
will including them 



$! ................... Cut between dotted lines and save. ...................
$!...........................................................................
$! VAX/VMS archive file created by VMS_SHARE V06.10 7-FEB-1989.
$!
$! VMS_SHARE was written by James Gray (Gray:OSBUSouth@Xerox.COM) from
$! VMS_SHAR by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au).
$!
$! To unpack, simply save, concatinate all parts into one file and
$! execute (@) that file.
$!
$! This archive was created by user TNIELAND
$! on 12-JUN-1989 10:47:44.48.
$!
$! It contains the following 5 files:
$!        FINGER.DIFF
$!        FINGER_BUILD.COM
$!        IDLE-MON.MAR
$!        INSTALL_FINGER.COM
$!        TERMINAL.MAR
$!
$!============================================================================
$ SET SYMBOL/SCOPE=( NOLOCAL, NOGLOBAL )
$ VERSION = F$GETSYI( "VERSION" )
$ IF VERSION .GES "V4.4" THEN GOTO VERSION_OK
$ WRITE SYS$OUTPUT "You are running VMS ''VERSION'; ", -
    "VMS_SHARE V06.10 7-FEB-1989 requires VMS V4.4 or higher."
$ EXIT 44 ! SS$_ABORT
$VERSION_OK:
$ GOTO START
$!
$UNPACK_FILE:
$ WRITE SYS$OUTPUT "Creating ''FILE_IS'"
$ DEFINE/USER_MODE SYS$OUTPUT NL:
$ EDIT/TPU/COMMAND=SYS$INPUT/NODISPLAY/OUTPUT='FILE_IS'/NOSECTION -
    VMS_SHARE_DUMMY.DUMMY
b_part := CREATE_BUFFER( "{Part}", GET_INFO( COMMAND_LINE, "file_name" ) )
; s_file_spec := GET_INFO( COMMAND_LINE, "output_file" ); SET( OUTPUT_FILE
, b_part, s_file_spec ); b_errors := CREATE_BUFFER( "{Errors}" ); i_errors 
:= 0; pat_beg_1 := ANCHOR & "-+-+-+ Beginning"; pat_beg_2 := LINE_BEGIN 
& "+-+-+-+ Beginning"; pat_end := ANCHOR & "+-+-+-+-+ End"; POSITION
( BEGINNING_OF( b_part ) ); LOOP EXITIF SEARCH( SPAN( ' ' )@r_trail 
& LINE_END, FORWARD) = 0; POSITION( r_trail ); ERASE( r_trail ); ENDLOOP
; POSITION( BEGINNING_OF( b_part ) ); i_append_line := 0; LOOP EXITIF MARK
( NONE ) = END_OF( b_part ); s_x := ERASE_CHARACTER( 1 )
; IF s_x = '+' THEN r_skip := SEARCH( pat_beg_1, FORWARD, EXACT ); IF r_skip 
<> 0 THEN s_x := ''; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ERASE_LINE; ENDIF
; ENDIF; IF s_x = '-' THEN r_skip := SEARCH( pat_end, FORWARD, EXACT )
; IF r_skip <> 0 THEN s_x := ''; MOVE_HORIZONTAL( -CURRENT_OFFSET ); m_skip 
:= MARK( NONE ); r_skip := SEARCH( pat_beg_2, FORWARD, EXACT ); IF r_skip 
<> 0 THEN POSITION( END_OF( r_skip ) ); MOVE_HORIZONTAL( -CURRENT_OFFSET )
; MOVE_VERTICAL( 1 ); MOVE_HORIZONTAL( -1 ); ELSE POSITION( END_OF( b_part ) 
); ENDIF; ERASE( CREATE_RANGE( m_skip, MARK( NONE ), NONE ) ); ENDIF; ENDIF
; IF s_x = 'V' THEN s_x := ''; IF i_append_line <> 0 THEN APPEND_LINE
; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF; i_append_line := 1
; MOVE_VERTICAL( 1 ); ENDIF; IF s_x = 'X' THEN s_x := ''; IF i_append_line 
<> 0 THEN APPEND_LINE; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF
; i_append_line := 0; MOVE_VERTICAL( 1 ); ENDIF; IF s_x <> '' THEN i_errors 
:= i_errors + 1; s_text := CURRENT_LINE; POSITION( b_errors ); COPY_TEXT
( "The following line could not be unpacked properly:" ); SPLIT_LINE
; COPY_TEXT( s_x ); COPY_TEXT( s_text ); POSITION( b_part ); MOVE_VERTICAL
( 1 ); ENDIF; ENDLOOP; POSITION( BEGINNING_OF( b_part ) ); LOOP r_x := SEARCH
( "`", FORWARD, EXACT ); EXITIF r_x = 0; POSITION( r_x ); ERASE_CHARACTER( 1 
); COPY_TEXT( ASCII( INT( ERASE_CHARACTER( 3 ) ) ) ); ENDLOOP
; IF i_errors = 0 THEN SET( NO_WRITE, b_errors, ON ); ELSE POSITION
( BEGINNING_OF( b_errors ) ); COPY_TEXT( FAO
( "The following !UL errors were detected while unpacking !AS", i_errors
, s_file_spec ) ); SPLIT_LINE; SET( OUTPUT_FILE, b_errors, "SYS$COMMAND" )
; ENDIF; EXIT; 
$ DELETE VMS_SHARE_DUMMY.DUMMY;*
$ CHECKSUM 'FILE_IS
$ WRITE SYS$OUTPUT " CHECKSUM ", -
  F$ELEMENT( CHECKSUM_IS .EQ. CHECKSUM$CHECKSUM, ",", "failed!!,passed." )
$ RETURN
$!
$START: 
$ FILE_IS = "FINGER.DIFF"
$ CHECKSUM_IS = 121913525
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X************
XFile FALCON$DUB3:[TNIELAND.FINGER]FINGER.FOR;17
V  206   c`009 V51.1.15       Mods at AAMRL - Can now determine Idle times. Us
Xing
X  207   c`009`009`009TERMINAL.MAR from Joe Meadows.
X  208   c`009`009`009By Ted Nieland`009`009`009`00912-Jun-1989
X  209   c
X******
XFile FALCON$DUB3:[TNIELAND.FINGER]FINGER.FOR;2
X  206   c
X************
X************
XFile FALCON$DUB3:[TNIELAND.FINGER]FINGER.FOR;17
X  220   `0091`009/'VAX/VMS Finger: Version V51.1.15 of 12-Jun-1989'/
X  221   `009Common`009/Version_Common/ VersionMsg
X******
XFile FALCON$DUB3:[TNIELAND.FINGER]FINGER.FOR;2
X  217   `0091`009/'VAX/VMS Finger: Version V51.1.14 of 06-Jun-1989'/
X  218   `009Common`009/Version_Common/ VersionMsg
X************
X************
XFile FALCON$DUB3:[TNIELAND.FINGER]FINGER.FOR;17
X 1915   `009Write(Size,1003) PgCnt
X 1916   `009Location = Get_Location(Terminal,TTType,PID)
X 1917   c  Turn on CMKRNL privilege
X 1918   `009    Privilege(1) =  Prv$M_CMKRNL
X 1919   `009    Call Sys$Setprv(%Val(1),Privilege,,)
X 1920   `009If ( (Testoutput.and.FlagIdleTime) .ne. 0 )
X 1921   `0091`009Idle_Time = Get_Idle(Terminal)
X 1922   c  Turn off CMKRNL privilege
X 1923   `009    Call Sys$Setprv(,Privilege,,)
X 1924   `009If ( (FlagProcess.and.FlagSubprocess) .ne. 0 ) then
X******
XFile FALCON$DUB3:[TNIELAND.FINGER]FINGER.FOR;2
X 1912   `009If ( (Testoutput.and.FlagIdleTime) .ne. 0 )
X 1913   `0091`009Idle_Time = Get_Idle(PID)
X 1914   `009Write(Size,1003) PgCnt
X 1915   `009Location = Get_Location(Terminal,TTType,PID)
X 1916   `009If ( (FlagProcess.and.FlagSubprocess) .ne. 0 ) then
X************
X************
XFile FALCON$DUB3:[TNIELAND.FINGER]FINGER.FOR;17
X 2765   `009Character*5 Function Get_Idle(Terminal)
X 2766  `032
X******
XFile FALCON$DUB3:[TNIELAND.FINGER]FINGER.FOR;2
X 2757   `009Character*5 Function Get_Idle(PID)
X 2758  `032
X************
X************
XFile FALCON$DUB3:[TNIELAND.FINGER]FINGER.FOR;17
X 2771   `009Integer`009`009I_hr, I_min, Status, offset
X 2772   `009Character*(*)`009Terminal
X 2773   `009Integer*4`009I_Idle,Term_PID
X 2774   `009Integer*2`009RTT_Link
X 2775  `032
X 2776   `009COMMON/TERM_INFO_STRUCT/ I_Idle,Term_PID,RTT_Link
X 2777  `032
X******
XFile FALCON$DUB3:[TNIELAND.FINGER]FINGER.FOR;2
X 2763   `009Integer`009`009I_Idle, I_hr, I_min
X 2764   `009Integer`009`009PID
X 2765  `032
X************
X************
XFile FALCON$DUB3:[TNIELAND.FINGER]FINGER.FOR;17
X 2780   C
X 2781   C       Call TERM_INFO to get the Idle time for terminals
V 2782   C       Make sure that the I_IDLE is zero first or it will use previo
Xus value
V 2783   C       TERM_INFO doesn't like the ':' in the terminal name, so ommit
X it.
X 2784   C
X 2785   `009
X 2786   `009I_Idle = 0
X 2787  `032
X 2788   `009offset = index(terminal,':')
X 2789   `009if (offset.eq.0) offset = len(terminal)
X 2790   `009Status = TERM_INFO(Terminal(:offset-1),I_Idle)
X 2791  `032
X 2792   `009If ( I_Idle .le. 0 ) Return
X******
XFile FALCON$DUB3:[TNIELAND.FINGER]FINGER.FOR;2
X 2768   c Some day this will be implemented
X 2769   `009I_Idle = 0
X 2770  `032
X 2771   200`009Continue
X 2772   `009If ( I_Idle .le. 0 ) Return
X************
X************
XFile FALCON$DUB3:[TNIELAND.FINGER]FINGER.FOR;17
X 3109   `009Fix_Name = First_name(:i_First)//SP//Last_name(:i_Last)
X 3110  `032
X******
XFile FALCON$DUB3:[TNIELAND.FINGER]FINGER.FOR;2
X 3089   c`009Fix_Name = First_name(:i_First)//SP//Last_name(:i_Last)
X 3090  `032
X************
X
XNumber of difference sections found: 7
XNumber of difference records found: 33
X
VDIFFERENCES /IGNORE=()/MERGED=1/OUTPUT=FALCON$DUB3:[TNIELAND.FINGER]IDLE_FING
XER.DIFFS;1-
X    FALCON$DUB3:[TNIELAND.FINGER]FINGER.FOR;17-
X    FALCON$DUB3:[TNIELAND.FINGER]FINGER.FOR;2
$ GOSUB UNPACK_FILE

$ FILE_IS = "FINGER_BUILD.COM"
$ CHECKSUM_IS = 644559196
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X$!..BuildLib.Com`009`009`009Build Finger Libraries
X$!..`009`009`009`009`009R. Garland / CUCHEM / Feb-1985
X$!.. VMS V5.1 version
X$ Set`009NoOn
X$ Type`009Sys$Input
X
X`009This procedure builds the required libraries for Finger.
X
X$ Inquire Ans "Do you wish to compile everything? (YES) "
X$ All = 0
X$ If Ans .eqs. "" then All = 1
X$ If Ans then All = 1
X$ If All then goto B_1
X$ Write`009`009Sys$Output`009" "`009! 'F$Verify(0)
X$ Inquire Ans "Do you wish to compile FINGER.FOR? (YES) "
X$ C_1 = 0
X$ If Ans .eqs. "" then C_1 = 1
X$ If Ans then C_1 = 1
X$ If .not. C_1 then Goto B_1_1
X$ B_1:
X$ Write`009`009Sys$Output`009" "`009! 'F$Verify(0)
X$ Set Verify
V$! ignore compiler warnings... harmless (which - the compiler or the warnings
X?)
X$ Fortran/nocheck/NoDebug`009FINGER.FOR
X$ Fortran/nocheck/NoDebug/NoOptimize FINGERSHO.FOR
X$ B_1_1:`009!'F$Verify(0)
X$ If All then goto B_2
X$ Write`009`009Sys$Output`009" "`009! 'F$Verify(0)
X$ Inquire Ans "Do you wish to compile FINGERSHR.FOR? (YES) "
X$ C_2 = 0
X$ If Ans .eqs. "" then C_2 = 1
X$ If Ans then C_2 = 1
X$ If .not. C_2 then Goto B_2_2
X$ B_2:
X$ Write`009`009Sys$Output`009" "`009! 'F$Verify(0)
X$ Set Verify
X$ Fortran/nocheck/NoDebug`009FINGERSHR.FOR
X$ B_2_2:`009!'F$Verify(0)
X$ If All then goto B_2A
X$ Write`009`009Sys$Output`009" "`009! 'F$Verify(0)
X$ Inquire Ans "Do you wish to compile FINGMAINT.FOR? (YES) "
X$ C_2A = 0
X$ If Ans .eqs. "" then C_2A = 1
X$ If Ans then C_2A = 1
X$ If .not. C_2A then Goto B_2_2A
X$ B_2A:
X$ Write`009`009Sys$Output`009" "`009! 'F$Verify(0)
X$ Set Verify
X$ Fortran/nocheck/NoDebug`009FINGMAINT.FOR
X$ B_2_2A:`009!'F$Verify(0)
X$ If All then goto B_3
X$ Write`009`009Sys$Output`009" "`009! 'F$Verify(0)
X$ Inquire Ans "Do you wish to compile FINGMAIN.FOR? (YES) "
X$ C_3 = 0
X$ If Ans .eqs. "" then C_3 = 1
X$ If Ans then C_3 = 1
X$ If .not. C_3 then Goto B_3_3
X$ B_3:
X$ Write`009`009Sys$Output`009" "`009! 'F$Verify(0)
X$ Set Verify
X$ Fortran/nocheck/NoDebug`009FINGMAIN.FOR
X$ B_3_3:`009!'F$Verify(0)
X$ If All then goto B_4
X$ Write`009`009Sys$Output`009" "`009! 'F$Verify(0)
X$ Inquire Ans "Do you wish to compile the other fortran routines? (YES) "
X$ C_4 = 0
X$ If Ans .eqs. "" then C_4 = 1
X$ If Ans then C_4 = 1
X$ If .not. C_4 then Goto B_4_4
X$ B_4:
X$ Write`009`009Sys$Output`009" "`009! 'F$Verify(0)
X$ Set Verify
X$ Fortran/nocheck/NoDebug`009DUMJ.FOR
X$ Fortran/nocheck/NoDebug`009TCPFINGER.FOR
X$ Fortran/nocheck/NoDebug`009FINGERDAE.FOR
X$ Fortran/nocheck/NoDebug`009GETQUEUE.FOR
X$ Fortran/nocheck/NoDebug FINGERTER.FOR
X$ B_4_4:`009!'F$Verify(0)
X$ If All then goto B_5
X$ Write`009`009Sys$Output`009" "`009! 'F$Verify(0)
X$ Inquire Ans "Do you wish to assemble the MACRO routines? (YES) "
X$ C_5 = 0
X$ If Ans .eqs. "" then C_5 = 1
X$ If Ans then C_5 = 1
X$ If .not. C_5 then Goto B_5_5
X$ B_5:
X$ Write`009`009Sys$Output`009" "`009! 'F$Verify(0)
X$ Set Verify
X$ Macro`009`009TERMINAL.MAR
X$ Macro`009`009IDLE-MON.MAR
X$ Macro`009`009WILD.MAR
X$ Macro`009`009KLUDGE.MAR
X$ Macro`009`009GETJIB.MAR
X$ B_5_5:`009!'F$Verify(0)
X$ If All then goto B_6
X$ Write`009`009Sys$Output`009" "`009! 'F$Verify(0)
X$ Inquire Ans "Do you wish to compile the .CLD and .MSG files? (YES) "
X$ C_6 = 0
X$ If Ans .eqs. "" then C_6 = 1
X$ If Ans then C_6 = 1
X$ If .not. C_6 then Goto B_6_6
X$ B_6:
X$ Write`009`009Sys$Output`009" "`009! 'F$Verify(0)
X$ Set Verify
X$ Set Command/Object`009FINGERCLD.CLD
X$ Set Command/Object`009MAINTCLD.CLD
X$ Message`009FINGERMSG
X$ B_6_6:`009!'F$Verify(0)
X$ If All then goto B_7
X$ Write`009`009Sys$Output`009" "`009! 'F$Verify(0)
X$ Inquire Ans "Do you wish to create new libraries? (YES) "
X$ C_7 = 0
X$ If Ans .eqs. "" then C_7 = 1
X$ If Ans then C_7 = 1
X$ If .not. C_7 then Goto B_7_7
X$ B_7:
X$ Write`009`009Sys$Output`009" "`009! 'F$Verify(0)
X$ Set Verify
X$ Library`009JLIB/Object/Create`009DUMJ
X$ Rename`009DUMJ.OBJ;*`009DUMJ.NOBJ;*`009!'F$Verify(0)
X$ Set Verify
X$ Library`009FINGERLIB/Object/Create`009*.OBJ
X$! Delete`009*.OBJ;*`009`009!'F$Verify(0)
X$ Set Verify
X$ Library`009FINGMAINT/Help/Create=(Blocks:12)  FINGMAINT
X$ Rename`009DUMJ.NOBJ;*`009DUMJ.OBJ;*
X$ Goto`009`009B_8`009!'F$Verify(0)
X$ B_7_7:`009!'F$Verify(0)
X$ Write`009`009Sys$Output`009" "`009! 'F$Verify(0)
X$ If .not. C_4 then goto B_7_2
X$ Set Verify
X$ Library`009JLIB/Object`009DUMJ
X$ Delete`009DUMJ.OBJ;*`009!'F$Verify(0)
X$ B_7_2:`009!'F$Verify(0)
X$ Set Verify
X$ Library`009FINGERLIB/Object`009*.OBJ
X$ Delete`009*.OBJ;*`009`009!'F$Verify(0)
X$ Set Verify
X$ Library`009FINGMAINT/Help`009FINGMAINT
X$ B_8:`009!'F$Verify(0)
X$ Type`009`009Sys$Input
X
X`009Time to clean up ...
X
X$ Inquire Ans "Do you wish to PURGE everything? (YES) "
X$ C_8 = 0
X$ If Ans .eqs. "" then C_8 = 1
X$ If Ans then C_8 = 1
X$ If .not. C_8 then Goto B_9
X$ Set Verify
X$ Purge/Log
X$ B_9:`009!'F$Verify(0)
X$ Type`009`009Sys$Input
X
X`009Libraries sucessfully built.
X$ Exit
$ GOSUB UNPACK_FILE

$ FILE_IS = "IDLE-MON.MAR"
$ CHECKSUM_IS = 186205167
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X`009.Title`009Install-Idle-Monitor
X;
X;`009This loads code into system space and patches into the
X;`009terminal port/class interface to update UCB$L_ABSTIM whenever
X;`009a character is sent or received. This allows us to keep
X;`009track of 'idletime' on non-TIMED devices.
X;
X
X`009.library /SYS$LIBRARY:LIB/
X`009$CXBDEF
X`009$DDTDEF
X`009$DPTDEF
X`009$DYNDEF
X`009$TTYUCBDEF
X`009$TTYVECDEF
X`009$UCBDEF
X
X`009.Entry`009Install_Idle_Monitor,`094m<>
X`009$CMKRNL_S   $$Install_Idle_Monitor
X`009Ret
X
X
X`009.Entry`009$$Install_Idle_Monitor,`094m<r2,r3,r4,r5,r6,r7>
X
X`009;
X`009;   See if we have an RTA0 device installed.
X`009;
X
X`009Clrl`009R7`009`009`009; Assume no RTDRIVER DDT to patch
X`009Jsb`009G`094Sch$IOLockR`009`009; Lock the I/O database
X
X`009MovAQ`009RT_DEVICE,R1
X`009Jsb`009G`094IOC$SearchDev`009`009; Search for RTA0
X`009Blbc`009R0,1$
X`009Movl`009UCB$L_DDT(R1),R7
X1$:
X
X;
X;`009Allocate a buffer to hold the code the be loaded into
X;`009nonpaged pool
X;
X
X`009MovL`009#CodeLen+12,R1`009`009; Skip 12 bytes for pool header
X`009TstL`009R7
X`009BEql`0092$
X`009AddW2`009DDT$W_FDTSIZE(R7),R1`009; Room for old FDT
X`009AddW2`009#3*4,R1`009`009`009; Room for the new FDT entry
X2$:
X
X`009Jsb`009G`094Exe$AllocBuf
X`009Blbs`009R0,10$
X`009Pushl`009R0
X`009Brb`009Done
X10$:
X
X;
X;`009Copy the code into the pool
X;
X
X`009MovAB`00912(R2),R6`009`009    ; Address of start of code
X`009MovC3`009#CodeLen,W`094Code,(R6)`009    ; Copy code into pool
X
X;
X;`009Link the code into the class interface to TTDRIVER.
X;
X
X`009MovL`009G`094TTY$GL_DPT,R1`009`009    ; Get TTDRIVER DPT
X`009MovZWL`009DPT$W_VECTOR(R1),R0`009    ; Offset to CLASS VECTOR
X`009AddL2`009R0,R1`009`009`009    ; Address of CLASS VECTOR
X
X`009MovL`009CLASS_GETNXT(R1),B`094V1_Jump-Code(R6)
X`009MovL`009CLASS_PUTNXT(R1),B`094V2_Jump-Code(R6)
X`009MovAB`009B`094V1-Code(R6),CLASS_GETNXT(R1)
X`009MovAB`009B`094V2-Code(R6),CLASS_PUTNXT(R1)
X
X;
X;`009Build a new FDT routine for RTTDRIVER.
X;
X`009Tstl`009R7
X`009Beql`00920$
X`009Addl3`009S`094#Patched_RT_FDT-Code,R6,R0; Pointer to start of new FDT
X`009Movl`009DDT$L_FDT(R7),R1`009    ; Pointer to start of old FDT
X`009MovQ`009(R1)+,(R0)+`009`009    ; Copy the supported I/O mask
X`009MovQ`009(R1)+,(R0)+`009`009    ; Copy the buffered I/O mask
X`009MovQ`009-16(R1),(R0)+`009`009    ; Copy the supported into the new entry
X`009MovAB`009B`094RTT_Fix-Code(R6),(R0)+    ; New FDT code address
X`009MovZWL`009DDT$W_FDTSIZE(R7),R2
X`009SubL2`009#16,R2`009`009`009    ; Calculate size of remaining FDT
X`009MovC3`009R2,(R1),(R0)`009`009    ; Move it
X`009MovAL`009B`094Patched_RT_FDT-Code(R6),DDT$L_FDT(R7)
V`009AddW2`009#12,DDT$W_FDTSIZE(R7)`009    ; Update the pointers to the new FD
XT
X20$:
X;
X;`009Exit
X;
X`009Pushl`009#SS$_NORMAL
XDone:`009Movl`009G`094CTL$GL_PCB,R4
X`009Jsb`009G`094SCH$IoUnLock
X`009PopL`009R0
X`009Ret
X
X
XRT_DEVICE:
X`009.Ascid`009/_RTB0:/
X
X;
X;   This code sits in between the port/class interface for each
X;   terminal and updates the "DUETIM" field when each I/O occurs
X;   It *Must* be PIC.
X;
XCode:
XV1:`009BBC`009#TTY$V_PC_NOTIME,UCB$W_TT_PRTCTL(R5),10$
X`009MovL`009@#EXE$GL_ABSTIM,UCB$L_DUETIM(R5)
X10$:`009Jmp`009@I`094#00000000
XV1_Jump = .-4
X
X
XV2:`009BBC`009#TTY$V_PC_NOTIME,UCB$W_TT_PRTCTL(R5),10$
X`009MovL`009@#EXE$GL_ABSTIM,UCB$L_DUETIM(R5)
X10$:`009Jmp`009@I`094#00000000
XV2_Jump = .-4
X
XRtt_Fix:MovL`009@#EXE$GL_ABSTIM,UCB$L_DUETIM(R5)
X`009Rsb
X
XCodeLen = .-Code
X
XPatched_RT_FDT:
X
X`009.End`009Install_Idle_Monitor
$ GOSUB UNPACK_FILE

$ FILE_IS = "INSTALL_FINGER.COM"
$ CHECKSUM_IS = 977980818
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X$ Save_verify`009:=`009'F$Verify(0)
X$!..Install_Finger.com`009`009`009Install Finger sytem
X$!..`009`009`009`009`009R. Garland / C.U.Chemistry / Feb-1985
X$!..`009`009`009`009`009For version 5.0 of VMS
X$!`009`009P1`009-`009Options: when set, instructions are terse
X$!`009`009`009`009and many more items are optional.
X$ On `009Error`009Then GoTo Exit
X$ Options`009==`0090
X$ If`009P1.eqs.""`009Then Goto A$1
X$ Options`009==`009P1
X$ A$1:
X$ Write`009`009Sys$Output`009" "
X$ If Options`009Then Goto L1
X$ Type`009`009Sys$Input
X`009This procedure installs the Finger program and associated
X`009programs on your system.   For each question asked by this
X`009procedure, a default answer is given in parentheses after
X`009the question.  Just hit <RETURN> and the default will be used.
X
X`009This procedure copies files into system directories and uses
X`009the INSTALL utility, so you need to be logged on with system
X`009privileges to proceed.
X
X`009Before running this procedure you should review the installation
X`009document ( FINGER.DOC ) and decide if any changes need to be
X`009made to any of the source files.  These must be edited by you and
X`009the object libraries must then be rebuilt using the procedure
X`009BUILD_FINGER.COM (or by hand).  If you did not receive the object
X`009libraries, you must run BUILD_FINGER before proceding.
X
X`009Some typical reasons for editing and rebuilding are to change
X`009the default qualifiers used by finger, or to change the capacity
X`009of the database for terminals, network nodes, users, etc.
X`009If you have more than 100 terminals, or more than 200 users, or
X`009more than 100 network hosts, review the installation document
X`009as relates to increasing these limits.
X
X$ Inquire`009Ans`009" Shall we proceed? (YES) "
X$ If`009Ans .eqs. ""`009Then GoTo Proceed
X$ If`009Ans`009`009Then GoTo Proceed
X$ GoTo`009`009Exit
X$ Proceed:
X$ Type`009`009Sys$Input
X
X`009The parts of the finger system go into several directories.  The
X`009help files will be put into SYS$HELP.  If there is a particular
X`009directory where executable programs for general use are kept
X`009at your site ( a public library ), then finger will be put
X`009there.  Otherwise it will be put in SYS$SYSTEM.  (In some of the
X`009commands in this procedure, the chosen directory will be given
X`009the logical name "Finger$Directory".  This name is not needed
X`009once the installation is complete.)
X
X$ L1:
X$ Inquire`009Ans`009" Give name of directory to be used (SYS$SYSTEM) "
X$ Write`009`009Sys$Output`009" "
X$ If`009`009Ans .eqs. ""`009`009Then Ans := Sys$System
X$ LogAns`009:=`009`009`009'F$Log(Ans)'
X$ If`009`009LogAns .eqs. ""`009`009Then LogAns := 'Ans'
X$ If Options`009Then Goto L2
X$ Type`009`009Sys$Input
X
X`009Ignore possible "... superceded" messages.
X
X$ L2:
X$ Define`009Finger$Directory`009'LogAns'
X$ Type`009`009Sys$Input
X
X`009If you have an old version of finger on your system, it
X`009will be deinstalled now.
X
X$ If Options`009Then Goto L3
X$ Type`009`009Sys$Input
X`009This procedure may produce several error messages:`032
X`009`009"No logical name match", or`032
X`009`009"known file entry not found", or`032
X`009`009"File not found".`032
X`009These messages can be ignored.
X
X$ L3:
X$ Set`009NoOn
X$ Set Verify
X$ Deasign/System/Exec`009FingerShr
X$ Run Sys$System:Install
XFinger$Directory:Finger`009/Delete
XFinger$Directory:FingerShr`009/Delete
X$ Type`009`009Sys$Input`009!`009'F$Verify(0)
X
X$ Inquire`009Ans -
X" Do you have ""jnet"" (IBM RSCS networking) support? (NO) "
X$ jnet`009=`0090
X$ jlib`009`009:=`009`009`009"Jlib/Lib"
X$ If`009`009Ans .eqs. ""`009`009Then GoTo j1
X$ If`009`009.not. Ans`009`009Then GoTo j1
X$ jlib `009`009:= `009`009`009"Jan_Lib:BITLib/Lib"
X$ jnet`009=`0091
X$ j1:
X$ If Options`009Then Goto L4
X$ Type`009`009Sys$Input
X
X`009The finger program and the database maintenance program
X`009will now be linked and moved to the appropriate directory.
X
X$ L4:
X$ If .not. Options`009Then Goto Lnk$1
X$ Write`009`009Sys$Output`009" "
X$ Inquire`009Ans`009" Link FINGERSHR? (YES) "
X$ If Ans.eqs.""`009Then Goto Lnk$1
X$ If .not. Ans`009`009Then Goto Lnk$2
X$ Lnk$1:
X$ Set Verify
X$ Link/notrace`009FingerLib/Lib/Include=FingerShr `009-
X`009`009/Share='F$Log("Finger$Directory")'FingerShr, -
X`009`009Sys$Input/Options
XGSMATCH=LEQUAL,1,12
X$ Lnk$2:`009! 'F$Verify(0)
X$ If .not. Options`009Then Goto Lnk$3
X$ Write`009`009Sys$Output`009" "
X$ Inquire`009Ans`009" Link FINGER? (YES) "
X$ If Ans.eqs.""`009Then Goto Lnk$3
X$ If .not. Ans`009`009Then Goto Lnk$4
X$ Lnk$3:
X$ If Jnet `009Then Goto Lnk$3a
X$ Set Verify
X$ Link/noTrace`009FingerLib/Lib/Include=Finger$Main, `009-
X`009`009'jlib',`009-
X`009`009Sys$System:Sys.Stb/Sel, `009`009-
X`009`009Sys$Input/Options `009`009`009-
X`009`009/Exe='F$Log("Finger$Directory")'Finger
XFinger$Directory:FingerShr/Share
X$ Goto Lnk$4
X$ Lnk$3a:
X$ Set Verify
X$ Link/noTrace`009FingerLib/Lib/Include=Finger$Main, `009-
X`009`009Sys$System:Sys.Stb/Sel, `009`009-
X`009`009Sys$Input/Options `009`009`009-
X`009`009/Exe='F$Log("Finger$Directory")'Finger
XFinger$Directory:FingerShr/Share
Xjanshr/share
X$ Lnk$4:`009! 'F$Verify(0)
X$ If .not. Options`009Then Goto Lnk$5
X$ Write`009`009Sys$Output`009" "
X$ Inquire`009Ans`009" Link FINGMAINT? (YES) "
X$ If Ans.eqs.""`009Then Goto Lnk$5
X$ If .not. Ans`009`009Then Goto Lnk$6
X$ Lnk$5:
X$ Set Verify
X$ Link/notrace`009FingerLib/Lib/Include=FingMaint, `009-
X`009`009Sys$Input/Options `009`009`009-
X`009`009/Exe='F$Log("Finger$Directory")'FingMaint
XFinger$Directory:FingerShr/Share
X$ LNK$6:`009! 'F$Verify(0)
X$ If .not. Options`009Then Goto Lnk$7
X$ Write`009`009Sys$Output`009" "
X$ Inquire`009Ans`009" Link IDLE-MON? (YES) "
X$ If Ans.eqs.""`009Then Goto Lnk$7
X$ If .not. Ans`009`009Then Goto Lnk$8
X$ LNK$7:
X$ Set Verify
X$ Link/notrace`009Idle-Mon,SYS$SYSTEM:SYS.STB/SELECT`009-
X`009`009/Exe='F$Log("Finger$Directory")'Idle-Mon
X$ LNK$8:`009! 'F$Verify(0)
X$ Write`009`009Sys$Output`009" "
X$ Set Verify
X$ Define/System/Exec`009FingerShr`009'F$Log("Finger$Directory")'FingerShr
X$ If Options`009Then Goto L5`009! 'F$Verify(0)
X$ Type`009`009Sys$Input
X
X`009The help files will now be installed in SYS$HELP.  This
X`009step may fail if someone else is using the HELP utility.
X`009If it does, just repeat the LIB command (below) at a
X`009later time.
X$ L5:
X$ Set `009`009NoOn
X$ If .not. Options`009Then Goto Hlp$1
X$ Write`009`009Sys$Output`009" "
X$ Inquire`009Ans`009" Replace HELP files? (YES) "
X$ If Ans.eqs.""`009Then Goto Hlp$1
X$ If .not. Ans`009`009Then Goto Hlp$2
X$ Hlp$1:
X$ Write`009`009Sys$Output`009" "
X$ Set Verify
X$ Copy`009`009FingMaint.Hlb`009`009Sys$Help
X$ Lib`009`009Sys$Help:Helplib/Help`009Finger
X$ Hlp$2:`009! 'F$Verify(0)
X$ On `009Error`009Then GoTo Exit
X$ If Options`009Then Goto L6
X$ Type`009`009Sys$Input`009
X
X`009If you run DECnet, the Finger network object must be
X`009defined and the finger object command file must be
X`009copied to SYS$SYSTEM.
X
X`009If you already run Finger as a network object, skip this step.
X$ L6:
X$ Write`009`009Sys$Output`009" "
X$ Inquire`009Ans`009" Do you want the DECnet finger object defined? (YES) "
X$ NetFinger`009=`0090
X$ If`009`009Ans .eqs. ""`009Then GoTo DECnet
X$ If`009`009Ans `009`009Then GoTo DECnet
X$ GoTo`009`009NoDECnet
X$ DECnet:
X$ NetFinger`009=`0091
X$ Write`009`009Sys$Output`009" "
X$ Set Verify=(procedure,image)
X$ Run Sys$System:NCP
XDEFINE  OBJECT FINGER`009FILE FINGER`009NUMBER 117
XSET`009OBJECT FINGER`009FILE FINGER`009NUMBER 117
X$ Open/Write`009FingerNCP`009Sys$System:Finger.Com`009!'F$Verify(0)
V$ Write FingerNCP "$!FINGER.COM`009`009R. Garland / C.U. Chem. Dept. / Feb. 1
X985"
X$ Write FingerNCP "$ Set`009`009NoOn"
X$ Write FingerNCP "$!Assign/user`009NL:`009FINGER$MESSAGE"
X$ Write FingerNCP "$ Run`009`009''F$Log(""Finger$Directory"")'FINGER"
X$ Write FingerNCP "$ Exit"
X$ Close`009FingerNCP
X$ Set File/Protection=(S:RWED,O:RWED,G:RE,W:RE) Sys$System:Finger.Com
X$ NoDECnet:`009! 'F$Verify(0)
X$ If Options`009Then Goto L7
X$ Type`009`009Sys$Input
X
X`009We will now optionally purge old versions of the files`032
X`009which have just been installed.
X$ L7:
X$ Write`009`009Sys$Output`009" "
X$ Inquire`009Ans`009" Purge files just installed? (YES) "
X$ If`009`009Ans .eqs. ""`009Then GoTo Purge
X$ If`009`009Ans `009`009Then GoTo Purge
X$ GoTo`009`009NoPurge
X$ Purge:
X$ If Options`009Then Goto L8
X$ Type`009`009`009Sys$Input
X
X`009Ignore any "Error searching for ... File not found." messages.
X$ L8:
X$ Write`009`009Sys$Output`009" "
X$ Set Verify
X$ Purge/Log`009Sys$Help:FingMaint.Hlb
X$ Purge/Log`009'F$Log("Finger$Directory")'Finger.exe
X$ Purge/Log`009'F$Log("Finger$Directory")'FingerShr.exe
X$ Purge/Log`009'F$Log("Finger$Directory")'FingMaint.exe
X$ Purge2:`009! 'F$Verify(0)'
X$ If`009.not. NetFinger`009`009Then GoTo Purge3
X$ Set Verify
X$ Purge/Log`009Sys$System:Finger.Com
X$ Purge3:`009! 'F$Verify(0)'
X$ NoPurge:`009! 'F$Verify(0)'
X$ Type`009`009Sys$Input
X
X`009The program will now be installed with the privileges needed.
X
X$ Set Verify
X$ Set Prot=(W:rwe)`009'F$Log("Finger$Directory")'FingerShr.Exe
X$ Run Sys$System:Install
XFinger$Directory:Finger /Open /Shared /Header /Priv=(SYSPRV,WORLD,CMKRNL)
XFinger$Directory:FingerShr /Open /Shared /Header /Write /Priv=(SYSPRV,SYSGBL)
X$! Set Prot=(W:re)`009'F$Log("Finger$Directory")'FingerShr.Exe
X$ If Options`009Then Goto L9`009! 'F$Verify(0)
X$ Type`009`009Sys$Input
X
X`009The installation procedure is now complete.  However you must
X`009do several things more:
X
X`0091) You must call the Finger start-up code, START_FINGER.COM,
X`009   from the system startup file, SYS$MANAGER:SYSTARTUP.COM,
X`009   so that the program will work after rebooting. START_FINGER.COM`032
X`009   must be edited for your site.
X
X`009   You must also run the Idle-Mon program during the start up
X`009   procedure if you wish to have idle times for RTA and LTA terminals.
X`009   The Idle-Mon program needs to be run after DECNet has been started
X`009   but before LAT is started.  The program can be activated by`032
X`009   the command:
X
V$ WRITE SYS$OUTPUT "                   $ RUN ''F$LOG("Finger$Directory")'Idle
X-Mon"
X$ Type`009`009Sys$Input
X
X`0092) Finger must be defined as a foreign command for users.  The
X`009   following line should be put into your system wide login command
X`009   file:
X
X$ L9:
X$ Set Verify
X$ F*INGER`009:==`009$'F$Log("Finger$Directory")'Finger
X$! 'F$Verify(0)
X$ If Options`009Then Goto L10
X$ Type`009Sys$Input`032
X
X`0093) If you want a file containing a system message ("message of the
X`009   day") displayed as part of the FINGER output, create the file
X`009   and assign it the logical name "Finger$Message".  This can be
X`009   done via a /SYSTEM logical name at BOOT time.
X
X`0094) If you use jnet, and want to build the Finger daemon, you should
X`009   review the documentation (FINGER.DOC) and run the procedure
X`009   INSTALL_JNET_FINGER.COM and also put a call to the startup code
X`009   START_JNET_FINGER.COM into your jnet startup procedure.
X
X`0095) You must use the FINGMAINT program which was copied to the des-
X`009   ignated directory, to define the database for personal names,`032
X`009   terminal locations and network hosts.  There is a sample file,
X`009   START_FINGER.COM, which you can use as a model for this.  The
X`009   definitions should be edited into START_FINGER if you desire to
X`009   reconstruct the database after each system Boot.`032
X
X`009Finger will now be run as a test.  If the results do not correspond
X`009to the sample output in the installation document, please review
X`009the procedure and start over.
X$ L10:
X$ If .not. Options`009Then Goto Clr$1
X$ Write`009`009Sys$Output`009" "
X$ Inquire`009Ans`009" Clear FINGERSHR database? (YES) "
X$ If Ans.eqs.""`009Then Goto Clr$1
X$ If .not. Ans`009`009Then Goto Clr$2
X$ Clr$1:
X$ Run`009'F$Log("Finger$Directory")'FingMaint
XClear`009/All
XExit
X$ Clr$2:
X$ Write`009`009Sys$Output`009" "
X$ Set Verify
X$ FINGER
X$ Exit:`009`009! 'F$Verify(0)
X$ Exit`009`009! 'F$Verify(Save_Verify)
$ GOSUB UNPACK_FILE

$ FILE_IS = "TERMINAL.MAR"
$ CHECKSUM_IS = 1360863026
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X`009.Title`009TERM_Info - Get information about a terminal
X`009.Ident`009/V01.001/
X`009.Enable`009SUP                                `032
X`009.Default Displacement,Word
X`009.Subtitle Introduction
X;+
X;
X; ----- TERM_Info:  Get information about a terminal;
X;
X; Facility:
X;
X;`009VAX/VMS system programming
X;
X; Abstract:
X;
X;`009This module provides a routine which can be called from any
X;`009VAX native  language to obtain information about a specific
X;`009terminal.
X;
X; Environment:
X;
X;`009VAX/VMS native mode, VMS V4.2 or later, CMKRNL privilege.
X;
X; Version:`009V01.001
X; Date:`009`00912-Apr-1988
X;
X;
X; Modifications:
X;
X;
X;-
X
X`009.Page
X`009.Subtitle Local definitions
X
X`009.Library "SYS$LIBRARY:LIB"
X`009`009;Get special macros from here
X`009.Link`009"SYS$SYSTEM:SYS.STB"/Selective_Search
X`009`009;Ease the link process a bit
X
X`009.NoCross`009;Save a tree
X
X`009$DCDEF`009`009`009`009;Device class & type definitions
X`009$DDBDEF`009`009`009`009;Device data block offsets
X`009$SSDEF`009`009`009`009;System service codes
X`009$TTYUCBDEF`009`009`009;Terminal UCB offsets
X`009$UCBDEF`009`009`009`009;UCB offsets
X
X`009.Cross`009`009`009`009;Turn CREF back on
X
X
X`009.Page
X`009.Subtitle`009TERMINFO`009- Get information about a terminal
X
X;+
X;
X; ----- TERM_INFO:  Get information about a terminal
X;
X;
X; The calling program must have  CMKRNL privilege and  must be linked
X; with SYS.STB.
X;
X; Call sequence:
X;
X;  status.wlv = TERM_INFO (terminal.rt.dx, term_info_structure.m?.r)
X;  term_info_structure :
X;`009.long`009ucb$l_duetim
X;`009.long`009ucb$l_pid
X;`009.word`009ucb$w_wrtt_link
XINFO_SIZE = 10
X;
X; Inputs:
X;
X;`0094(AP)`009- Address of a descriptor of the device name.
X;
X; Outputs:
X;
X;`0098(AP)`009- Address of a term_info structure.
X;
X;`009R0`009- SS$_NOPRIV:`009 No CMKRNL privilege.
X;`009`009- SS$_ACCVIO:`009 One of the arguments is not accessible.
X;`009`009- SS$_NOSUCHDEV: The specified device can't be found.
X;`009`009- SS$_IVDEVNAM:`009 The specified device isn't a terminal.
X;`009`009- SS$_NORMAL:`009 Success.
X;
X;-
X
X`009.Psect`009TERM_INFO`009EXE,RD,NOWRT,PIC,SHR,PAGE
X
X`009.Entry`009TERM_INFO,`094M<>`009`009; Entry here
X
X`009$CMKRNL_S ROUTIN=B`09420$,-`009; Do this
X`009`009ARGLST=(AP)`009`009;   in kernel mode
X
X10$:`009RET`009`009`009`009; Done, status in R0
X
X; Here in kernel mode to do all of the actual work.
X
X20$:`009.Word`009`094M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
X`009`009;Here in kernel mode to get some info
X
X; First, check to see if we can read the argument list.
X
X`009MOVL`009#SS$_ACCVIO,R0`009`009; Presume we can't
X`009IFNORD`009#<3*4>,(AP),10$`009`009; Probe the argument list
X
X; Check the number of arguments
X
X`009MOVL`009#SS$_INSFARG,R0`009`009; Presume we have too few arguments
X`009CMPB`009#2,(AP)`009`009`009; Do we have enough arguments?
X`009BNEQ`00910$`009`009`009; If NEQ no, it's wrong somehow
X`009
X; Check to see if we can write the term_info structure.
X`009
X`009MOVL`009#SS$_ACCVIO,R0`009`009; Presume we can't
X`009IFNOWRT`009#INFO_SIZE,@8(AP),10$`009; Probe the term_info structure
X`009MOVL`0098(AP),R10`009`009; save the address of term_info struct.
X
X; See if we can read the device name descriptor.
X
X`009MOVL`0094(AP),R1`009`009; Address the device name descriptor
X`009JSB`009G`094EXE$PROBER_DSC`009; Probe the descriptor
X`009BLBC`009R0,10$`009`009`009; Sigh.
X`009MOVQ`009R1,-(SP)`009`009; Save copy of the probed descriptor
X`009MOVL`009SP,R11`009`009`009; Remember where it is
X`009CLRW`0092(R11)`009`009`009; Never mind the type and class info
X
X; Ok.  Now go hunt down the device the user told us was a terminal
X
X`009MOVL`009G`094CTL$GL_PCB,R4`009`009; Get my PCB address
X`009JSB`009G`094SCH$IOLOCKR`009`009; Lock the I/O database mutex
X`009MOVL`009R11,R1`009`009`009; Address the device name descriptor
X`009JSB`009G`094IOC$SEARCHDEV`009`009; Go search for the device.
X`009BLBC`009R0,30$`009`009`009; We lose.
X
X; Now check to see if it's really a terminal.
X`009MOVL`009#SS$_IVDEVNAM,R0`009; Presume it isn't a terminal
X       `009CMPB`009#DC$_TERM,UCB$B_DEVCLASS(R1)`009; Is it a terminal?
X`009BNEQ`00930$`009`009`009; If NEQ no.
X
X; okay, we have this device UCB in R1, let's change it so that the
X; physical UCB is in R1, and the logical UCB is in R2, note that
X; these may well be the same thing, only if the terminal is redirected
X; will there be any differene.
X`009MOVL`009UCB$L_TL_PHYUCB(R1),R2
X`009BEQL`00921$
X`009MOVL`009R2,R1`009; okay, store the physical UCB in R1...
X
X21$:`009; Let's get R2 pointing to logical UCB if there is one, else physical
X    `009MOVL`009R1,R2`009; assume it's not redirected
X`009BBC`009#DEV$V_RED,UCB$L_DEVCHAR2(R1),22$
X`009MOVL`009UCB$L_TT_LOGUCB(R1),R2
X`009BNEQ`00922$
X`009MOVL`009R1,R2`009; this should never occur
X
X22$:`009CLRW`009R3`009`009`009; clear the link number
X`009BBC`009#DEV$V_RTT,UCB$L_DEVCHAR2(R1),25$
X`009MOVW`009UCB$W_RTT_LINK(R1),R3`009; get the link number
X
X25$:`009MOVL`009UCB$L_DUETIM(R1),R0`009; get duetim
X`009BEQL`00926$`009`009`009; if zero, save it as zero...
X`009SUBL3`009R0,G`094EXE$GL_ABSTIM,R0`009; save duetim
X26$:`009MOVL`009R0,(R10)+
X
X27$:`009MOVL`009UCB$L_PID(R2),R0`009; Get internal PID
X   `009JSB`009G`094EXE$IPID_TO_EPID`009; Convert to extended PID
X`009MOVL`009R0,(R10)+`009`009; Save external PID
X`009MOVW`009R3,(R10)+`009`009; save rtt_link
X
X`009MOVL`009#SS$_NORMAL,R0`009`009; Success!
X`009MOVL`009G`094CTL$GL_PCB,R4`009`009; Get my PCB address again
X
X30$:`009PUSHL`009R0`009`009`009; Save the return status
X`009JSB`009G`094SCH$IOUNLOCK`009`009; Unlock the I/O database mutex
X`009SETIPL`009#0`009`009`009; Drop back down from IPL$_ASTDEL
X`009POPL`009R0`009`009`009; Restore the return status
X`009RET`009`009`009`009; Back to user mode
X
X`009.End
$ GOSUB UNPACK_FILE
$ EXIT
