SYSPRO2@TAMVENUS.BITNET.UUCP (02/13/87)
Here is a copy of the program written by Gerard Newman. The program has been
modified by Brad Wilson. The program would crash my machine if I passed a RT
terminal type to the program. Brad's fix took care of this.
.Title LAT_Info - Get information about a LAT terminal
.Ident /V01.000/
.Enable SUP
.Default Displacement,Word
.Subtitle Introduction
;+
;
; ----- LAT_Info: Get information about a LAT terminal
;
;
; Facility:
;
; VAX/VMS system programming
;
; Abstract:
;
; This module provides a routine which can be called from any
; VAX native language to obtain information about a specific
; LAT terminal.
;
; Environment:
;
; VAX/VMS native mode, VMS V4.2 or later, LATPlus V01.012, CMKRNL
; privilege.
;
;
;
; Version: V01.000
; Date: 19-Dec-1986
;
; Gerard K. Newman
; San Diego Supercomputer Center
; GA Technologies
; P.O. Box 85608
; San Diego, CA 92138
; 619.534.5076
;
; GKN@SDSC.ARPA, GKN@SDSC.BITNET
;
; Modifications:
;
; BMW001 -- (5-jan-1987) Check for non-zero physical UCB before
; following chain of indirection.
; BMW002 -- (5-jan-1987) Use intermediate buffering to avoid some
; sticky problems: (1) allow other types of
; descriptors by copying info from local buffers
; to user buffers (in user mode). (2) Modify
; internal calling mechanism to include length
; arguments, thus avoid modifying the descriptor
; which was only probed for read access.
;
;
;-
.Page
.Subtitle Local definitions
.Library "SYS$LIBRARY:LIB" ;Get special macros from here
.Link "SYS$SYSTEM:SYS.STB"/Selective_Search ;Ease the link
; ;process a bit
.NoCross ;Save a tree
$DCDEF ;Device class & type definitions
$DDBDEF ;Device data block offsets
$DSCDEF ;Descriptor symbols (BMW002)
$SSDEF ;System service codes
$TTYUCBDEF ;Terminal UCB offsets
$UCBDEF ;UCB offsets
.Cross ;Turn CREF back on
; Local definitions
; Constants that are likely to change in a future release of VMS that are not
; defined in SYS.STB or in a macro anywhere. These values come from looking
; at the running system with SDA.
; Offset in an LT UCB to the length of the port name, which is a counted
; string. Immediately following the port name is another counted string
; which is the LAT node name.
UCB$B_LT_PORT = ^X134 ;Offset to the port name length
UCB$B_LT_SESS = ^X195 ;Offset to the session number
.Page
.Subtitle LAT_INFO - Get information about a LAT terminal
;+
;
; ----- LAT_INFO: Get information about a LAT terminal
;
;
; This routine can be called by any VAX native language to obtain the server
; name, port name and session number of a LAT connection given a LT device
; name. The calling program must have CMKRNL privilege and must be linked
; with SYS.STB.
;
; Caveats:
;
; Will only work with fixed (non-dynamic) string descriptors.
; (BMW002) modified to work with any type string descriptor.
;
; Call sequence:
;
; status.wlv = LAT_INFO (terminal.rt.dx, session.wlr,
; server.wt.dx, port.wt.dx)
;
; Inputs:
;
; 4(AP) - Address of a descriptor of the LT device name.
; 8(AP) - Address of a longword to return the session number in.
; 12(AP) - Address of a descriptor to return the server name.
; 16(AP) - Address of a descriptor to return the server port name.
;
; Outputs:
;
; R0 - SS$_NOPRIV: No CMKRNL privilege.
; - SS$_ACCVIO: One of the arguments is not accessible.
; - SS$_NOSUCHDEV: The specified LT device can't be found.
; - SS$_IVDEVNAM: The specified device isn't a LAT terminal.
; - SS$_NORMAL: Success.
; (BMW002) other status codes may be returned by the RTL
;
; (BMW002)
;
; Internally, the routine calls a kernel mode routine which does
; the actual lookup. This k-mode routine can only handle fixed
; length string descriptors for the two output parameters, and
; will only accept fixed length or dynamic string descriptors for
; the terminal name (which is read-only). In order to implement
; other string types, the routine provides intermediate buffering
; of the three string parameters. Two additional parameters are
; passed to the kernel mode routine. These are used to receive
; the actual lengths of the server name and port name. In essence,
; the internal k-mode routine is called with the following argument
; list:
;
; status = krtn( terminal.rt.dx, session.wlr,
; server.wt.dx, port.wt.dx,
; slength.wwr, plength.wwr )
;
; 4(AP) - address of dynamic string descriptor containing
; the terminal name (read-only).
; 8(AP) - address of a longword to receive the session
; number (copied directly from the user's
; argument list).
; 12(AP) - address of a fixed length string descriptor to
; receive the server name.
; 16(AP) - address of a fixed length string descriptor to
; receive the port name.
; 20(AP) - address of a word to receive the length of the
; server name.
; 24(AP) - address of a word to receive the length of the
; port name.
;
; (BMW002)
;-
;+
; (BMW002) Add local data Psect
;-
.Psect LAT_DATA,REL,CON,NOEXE,LCL,NOPIC,WRT,NOSHR,QUAD
Server_Name:
.blkb 128 ; reserve 128 characters for name
Server_Length=.-Server_Name
Port_Name:
.blkb 128 ; reserve 128 characters for name
Port_Length=.-Port_Name
.align quad ; start descriptors on quad boundary
; ; (not absolutely necessary)
; Set up the descriptors. We will use a dynamic string for the terminal
; name, since it is treated as read-only by the kernel mode routine
; (i.e. additional space will not need to be allocated once in kernel
; mode). The server and port names are set up as statically allocated
; strings so that the kernel mode routine may precheck the buffers for
; write accessibility. We could use dynamic strings for them also, but
; we would have to call LIB$SGET_DD to get space before calling the
; kernel mode routine (the k-mode routine is incapable of allocating
; dynamic string space itself).
Terminal_Desc:
.word 0 ; Empty Dynamic string
.byte DSC$K_DTYPE_T ; character-coded text
.byte DSC$K_CLASS_D ; Dynamic string descriptor
.long 0 ; Empty Dynamic string
Server_Desc:
.word Server_Length ; length of buffer
.byte DSC$K_DTYPE_T ; character-coded text
.byte DSC$K_CLASS_S ; scalar string descriptor
.address Server_Name ; buffer address
Port_Desc:
.word Port_Length
.byte DSC$K_DTYPE_T
.byte DSC$K_CLASS_S
.address Port_Name
Arglist:
.blkl 7 ; intermediate arglist
SName_Length:
.blkw 1 ; space for length of server name
PName_Length:
.blkw 1 ; space for length of port name
;+
; (BMW002) End of added Psect
;-
.Psect LAT_INFO,EXE,RD,NOWRT,PIC,SHR,PAGE
.Entry LAT_INFO,^M<R2,R3,R4,R5,R6> ;Entry here
MOVL #SS$_INSFARG,R0 ; Assume things are bad (BMW002)
CMPB #4,(AP) ; Check number of arguments (BMW002)
BNEQ 5$ ; Not enough arguments (BMW002)
MOVL 4(AP),R0 ; Point R0 to input terminal name
MOVAL Terminal_Desc,R1 ;Point R1 to output descriptor
;
; Note that the call to LIB$SCOPY_DXDX to copy the string has the
; side effect (since the output string is dynamic) of allocating
; space to the output string.
;
JSB G^LIB$SCOPY_DXDX6 ;Copy string
BLBC R0,5$ ; Exit on error
MOVL #SS$_ACCVIO,R0 ; Assume bad things
MOVL #6,ARGLIST ; Init count field of arglist (BMW002)
MOVAL Terminal_Desc,ARGLIST+4 ; move terminal name (BMW002)
MOVL 8(AP),ARGLIST+8 ; move session param directly (BMW002)
BEQL 5$ ; exit if it was omitted (BMW002)
MOVAL Server_Desc,ARGLIST+12 ; (BMW002)
MOVAL Port_Desc,ARGLIST+16 ; (BMW002)
MOVAL SName_Length,ARGLIST+20 ; (BMW002)
MOVAL PName_Length,ARGLIST+24 ; (BMW002)
BRB 6$ ; Some of the above branches are
; ; out of range. (BMW002)
5$: RET ; so we need 5$ to move the exit closer
6$:
$CMKRNL_S ROUTIN=B^20$,- ;Do this
ARGLST=ARGLIST ; in kernel mode (BMW002)
BLBC R0,10$ ; On error, return (BMW002)
;+ (BMW002)
;
; We now use the RTL routines to copy from our intermediate buffers
; (set up as static strings) into the user's buffers. This is done
; in normal user mode, so dynamic strings can be used without
; problems.
;
;-
MOVZWL SName_Length,R0 ; Setup for string copy
MOVAL Server_Name,R1
MOVL 12(AP),R2
JSB G^LIB$SCOPY_R_DX6 ; Do copy
BLBC R0,10$ ; On error, return
PUSHL R0 ; Else, save status
MOVZWL PName_Length,R0 ; Setup for string copy
MOVAL Port_Name,R1
MOVL 16(AP),R2
JSB G^LIB$SCOPY_R_DX6 ; Do copy
POPL R1 ; Get previous status into R1
BLBC R0,10$ ; Return if error on 2nd copy
CMPL #SS$_NORMAL,R1 ; If 1st was a total success,
BEQL 10$ ; Return status from 2nd copy
CMPL #SS$_NORMAL,R0 ; If 2nd copy was not ok,
BNEQ 10$ ; Return it's status
MOVL R1,R0 ; 2nd was ok, return 1st status
;+ (BMW002)
;
; End of string copy
;-
10$: RET ;Done, status in R0
; Here in kernel mode to do all of the actual work.
20$: .Word ^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11> ;Here in kernel mode
; ;to get some info
; First, check to see if we can read the argument list.
MOVL #SS$_ACCVIO,R0 ;Presume we can't
IFNORD #<7*4>,(AP),10$ ;Probe the argument list (BMW002)
; Check the number of arguments
MOVL #SS$_INSFARG,R0 ;Presume we have too few arguments
CMPB #6,(AP) ;Do we have enough arguments?
BNEQ 10$ ;If NEQ no, it's wrong somehow
; Check to see if we can write the session number.
MOVL #SS$_ACCVIO,R0 ;Presume we can't
IFNOWRT #4,@8(AP),10$ ;Probe the output session number
; See if we can read the device name descriptor.
MOVL 4(AP),R1 ;Address the LT device name descriptor
JSB G^EXE$PROBER_DSC ;Probe the descriptor
BLBC R0,10$ ;Sigh.
MOVQ R1,-(SP) ;Save a safe copy of the probed descriptor
MOVL SP,R11 ;Remember where it is
CLRW 2(R11) ;Never mind the type and class info
; See if we have write access to the two output descriptors.
MOVL 12(AP),R1 ;Address the server name output descriptor
JSB G^EXE$PROBEW_DSC ;Probe the descriptor
BLBC R0,10$ ;Sigh.
MOVQ R1,-(SP) ;Stash a safe copy of the descriptor
MOVL SP,R10 ;Remember where I put it
CLRW 2(R10) ;Never mind the type and class info
MOVL 16(AP),R1 ;Address the port name output descriptor
JSB G^EXE$PROBEW_DSC ;Probe the descriptor
BLBC R0,10$ ;Sigh.
MOVQ R1,-(SP) ;Stash a safe copy of said descriptor
MOVL SP,R9 ;Remember where it is
CLRW 2(R9) ;Never mind the type and class info
; Probe the Server length for write access (BMW002)
IFNOWRT #2,@20(AP),10$ ; (BMW002)
; Probe the Port length for write access (BMW002)
IFNOWRT #2,@24(AP),10$ ; (BMW002)
; Ok. Now go hunt down the device the user told us was a LAT terminal
; and see if it really is.
MOVL G^SCH$GL_CURPCB,R4 ;Get my PCB address
JSB G^SCH$IOLOCKR ;Lock the I/O database mutex
MOVL R11,R1 ;Address the device name descriptor
JSB G^IOC$SEARCHDEV ;Go search for the device.
BLBC R0,30$ ;We lose.
; Now check to see if it's even a terminal, and if it is see if it's a LAT
; terminal. Remember to chain to the physical UCB first in case this is
; a disconnectable terminal.
MOVL #SS$_IVDEVNAM,R0 ;Presume it isn't a terminal
CMPW #UCB$C_TT_LENGTH,UCB$W_SIZE(R1) ;Check length of UCB (BMW001)
BGTR 30$ ;UCB too short for term (BMW001)
TSTL UCB$L_TL_PHYUCB(R1) ;Check for phys UCB (BMW001)
BEQL 25$ ;no phys UCB, skip next (BMW001)
MOVL UCB$L_TL_PHYUCB(R1),R1 ;Get to the "real" UCB
25$: CMPB #DC$_TERM,UCB$B_DEVCLASS(R1) ;Is it a terminal? (BMW001)
BNEQ 30$ ;If NEQ no.
MOVL UCB$L_DDB(R1),R2 ;Find the DDB
CMPW #^A/LT/,DDB$T_NAME+1(R2) ;Is this a LAT terminal?
BNEQ 30$ ;If NEQ no
; It's a LAT terminal all right. Obtain the server name, port name and
; session number.
MOVZBL UCB$B_LT_SESS(R1),@8(AP) ;Stash the session number
MOVAB UCB$B_LT_PORT(R1),R1 ;Address the port name
MOVL R9,R6 ;Here's the output descriptor address
BSBB MOVE_ASCIC ;Move the port name
MOVW (R6),@24(AP) ;Return the length (BMW002)
MOVL R10,R6 ;R1 now points at the server name
BSBB MOVE_ASCIC ;So go move it, too
MOVW (R6),@20(AP) ;Return the length (BMW002)
MOVL #SS$_NORMAL,R0 ;Success!
30$: PUSHL R0 ;Save the return status
MOVL G^SCH$GL_CURPCB,R4 ;Get my PCB address again
JSB G^SCH$IOUNLOCK ;Unlock the I/O database mutex
SETIPL #0 ;Drop back down from IPL$_ASTDEL
POPL R0 ;Restore the return status
RET ;Back to user mode
; Short subroutine to move a .Ascic string to a place described by a
; descriptor. Forms a proper descriptor of the result, and handles
; short buffers, etc.
;
; Inputs:
;
; R1 - Address of the .Ascic string
; R6 - Address of the output descriptor
;
; Outputs:
;
; R1 - Address of one byte past the end of the .Ascic string
; R0-R5 - Smashed
MOVE_ASCIC: ;Here to move a .Ascic string
MOVZBL (R1)+,R0 ;Grab the string length
CMPW (R6),R0 ;Check the string length
BGEQU 10$ ;If GEQU then we can use it
MOVZWL (R6),R0 ;Else only copy what will fit
10$: MOVW R0,(R6) ;Stash the length
MOVC3 R0,(R1),@4(R6) ;Copy the string
RSB ;Done
.End