Date: Thu, 19 Sep 1996 17:08:00 -0400
Message-Id: <96091917080080@star.zko.dec.com>
From: everhart@star.zko.dec.com (Glenn C. Everhart 603 881 1497)
To: everhart@gce.com
Subject: get_location_to_sym.src
X-VMS-To: SMTP%"everhart@Gce.com"

From:	US2RMC::"DGSCOTT@STTHOMAS.EDU" "Greg Scott at the University of St. Thomas in Minnesota" 19-SEP-1996 16:36:58.65
To:	eagan@beet.sca.dec.com
CC:	star::everhart, star::tavares
Subj:	Re: Contributions for OpenVMS V3 Freeware CD?.

Glen, Joe -- 

Brendan Eagan forwarded a mail message around about the next OpenVMS 
Freeware CD.  I cooked up this little fortran program last year to dig
out the terminal server and port number for a LTAnnn device.  IT returns
this stuff in the DCL symbols, SERVER and PORT.  It's useful inside DCL
procedures that manage queues when you need to know this stuff and nothing
is currently printing.  (The lexical only works when the device is actually
open and in use.)

Anyway, here's the source code.  If it makes it onto the CD, that would
be really cool.

- Greg Scott
Scott Consulting Corporation

dgscott@stthomas.edu  or  72102.136@CompuServe.com
phone (612) 683-1099




	OPTIONS/EXTEND_SOURCE
!+
!  Name:	  GET_TERMINAL
!  Version:  01.00 5-MAR-1995
!
!  Author:	Greg Scott		Creation Date: 5-Mar-1995
!		Scott Consulting Corporation
!		4151 Knob Drive
!		Suite 201
!		Eagan, MN  55122
!
!		Phone (612) 683-1099
!
!	Permission is hereby granted to use this program in the public
!	domain in any manner the user sees fit.  We only ask that this
!	comment block with our name on the top remain unmodified.  We 
!	would appreciate a phone call or thank you if this program makes
!	anyone's life easier.
!-
!+
!
!
!  Modified by: (Name of modifier, date, explanation)
!
! NAME		DATE		Explanation
!
!  Environment:
!
!	VAX-11 FORTRAN, user mode.
!
!  Abstract:
!	This program returns the terminal server and port name for an
!	LTAnnn device.
!	
!
!  Processing:
!
!	Grab the incoming foreign command line (LIB$GET_FOREIGN).  This
!	should be the LTAnnn device.
!	SYS$ASSIGN the LTAnnn device.
!	Issue the SENSEMODE QIO to find out stuff about this LAT port.
!	(SYS$QIOW)
!	Dig out the server and port from the returned messy P1 buffer.
!	(See the I/O User's Guide, Volume 1, in the LAT Port Driver QIO
!	Interface section of the Terminal Driver chapter for details.
!	Look for "Obtaining Information About LAT Entities".)
!	Close the channel (SYS$DASSGN)
!	Set up symbols for our DCL caller with the terminal and port
!	strings (LIB$SET_SYMBOL).
!
!	
!  Inputs:
!	LTAnnn device from LIB$GET_FOREIGN
!
!
!  Outputs:
!	SERVER and PORT DCL symbols set with appropriate strings.
!
!
!  Side Effects:
!
!  Remarks:
!
!	
!  Logicals and LUN Usage:
!	CHN - The I/O channel used for the LTAnnn device.
!
!	Module header comments end here.
!*************************************************************************
!-	(Signifies the end of the header section)

!
	PROGRAM GET_TERMINAL

	IMPLICIT NONE
!
!  External References:
!
!
	EXTERNAL
	1	  LIB$GET_FOREIGN
	1	, LIB$SET_SYMBOL
	1	, SYS$ASSIGN
	1	, SYS$DASSGN
	1	, SYS$GETDVIW
	1	, SYS$QIOW

	INTEGER * 4
	1	  LIB$GET_FOREIGN
	1	, LIB$SET_SYMBOL
	1	, SYS$ASSIGN
	1	, SYS$DASSGN
	1	, SYS$GETDVIW
	1	, SYS$QIOW

!
!  Include Files:
!
	INCLUDE '($IODEF)/LIST'
	INCLUDE '($LATDEF)/LIST'
	INCLUDE '($SSDEF)/LIST'

!
!  Global Data:
!

!
!  Local Data:
!
	INTEGER * 1
	1	  LAT_BUFFER_BYTE(80)	! For scanning the LAT_BUFFER string

	INTEGER * 2
	1	  IOSB_WORD(4)		! For $QIOW status info.
	1	, ITEM_CODE_WORD	! Used in scanning LAT_BUFFER.
	1	, P3_WORD(2)		! Used with QIO SENSEMODE call

	INTEGER*4
	1	  CHN			! Channel # from SYS$ASSIGN
	1	, CMD_LENGTH		! Length of returned command string
	1	, FUNCTION		! QIO function code
	1	, I			! Temporary stuff
	1	, IOSB(2)		! Used with $QIO calls.
	1	, STATUS		! Returned status from external calls
	1	, LENGTH		!
	1	, P3_LONG		! Used in QIO SENSEMODE call.

	EQUIVALENCE (IOSB_WORD(1), IOSB(1))
	EQUIVALENCE (P3_WORD(1), P3_LONG)

	CHARACTER
	1	  CMD_STRING * 20
	1	, IOSB_STRING * 80
	1	, ITEM_CODE_STRING * 2
	1	, LAT_BUFFER * 80	! Buffer for returned LAT stuff
	1	, PORT_NAME * 20
	1	, SERVER_NAME * 20
	1	, STATUS_STRING * 8	! Return $STATUS to DCL

	EQUIVALENCE (ITEM_CODE_STRING, ITEM_CODE_WORD)
	EQUIVALENCE (LAT_BUFFER, LAT_BUFFER_BYTE(1))


!
!  Main body:
!
1000	STATUS = LIB$GET_FOREIGN(%DESCR(CMD_STRING)	! Command string
	1			, 			! Prompt string
	1			, %REF(CMD_LENGTH)	! Length of cmd string
	1			, )			! Flags
	IF (.NOT. STATUS) THEN
		CALL LIB$SIGNAL(%VAL(STATUS))
		GOTO 99900
	END IF

D	TYPE *,'CMD_STRING is ', CMD_STRING
D	TYPE *, 'Length is ', CMD_LENGTH

1100	STATUS = SYS$ASSIGN(			! Assign an I/O channel
	1	  %DESCR(CMD_STRING(1:CMD_LENGTH))	! Device name
	1	, %REF(CHN)				! Assigned channel
	1	, 					! Access mode.
	1	, )					! Mailbox logical name
	IF (.NOT. STATUS) THEN
		CALL LIB$SIGNAL(%VAL(STATUS))
		GOTO 99900
	END IF

1998	FORMAT ('Returned IOSB completion status', I8)
1999	FORMAT ('Returned status from $QIOW service', I8)
2000	FUNCTION = IO$_TTY_PORT .OR. IO$M_LT_SENSEMODE
	P3_LONG = LAT$C_ENT_PORT
	P3_WORD(2) = 2**LAT$V_SENSE_FULL
	! We are setting a bit in the upper half of PC_LONG.  Remember
	! they are EQUIVALENCEd in the declarations.  See the I/O User's
	! Guide for details on setting up this QIO call.
	STATUS = SYS$QIOW( 			! Event Flag
	1	, %VAL(CHN)			! Channel
	1	, %VAL(FUNCTION)		! Function code
	1	, %REF(IOSB)			! IOSB address
	1	, 				! AST address
	1	, 				! AST parameter
	1	, %REF(LAT_BUFFER)		! P1 (Buffer address)
	1	, %VAL(LEN(LAT_BUFFER))		! P2 (Length of buffer)
	1	, %VAL(P3_LONG)			! P3 (Type of entity)
	1	, 				! P4 (Entity name string descriptor)
	1	, 				! P5
	1	, )				! P6
	IF ((.NOT. STATUS) .OR. (.NOT. IOSB_WORD(1))) THEN
		IF (.NOT. STATUS) THEN
			WRITE (UNIT = IOSB_STRING, FMT = 1999) STATUS
		ELSE
			WRITE (UNIT = IOSB_STRING, FMT = 1998) IOSB_WORD(1)
			STATUS = IOSB_WORD(1)
		END IF

		TYPE *, IOSB_STRING
		CALL LIB$SIGNAL(%VAL(STATUS))
		GOTO 99000
	END IF
	! STATUS is the returned status from the system service call.
	! IOSB_WORD(1) is the completion status of the operation.
	! IOSB_WORD(3) contains the length of stuff returned in LAT_BUFFER
	! if the operation completed successfully.


!	The returned buffer, LAT_BUFFER, is a really ugly buffer of
!	stuff that looks kind of like an item list, but worse.  Each
!	field starts with a one word (16 bit) item code.  If the
!	LAT$V_STRING bit of the item code is set, then the field is a
!	string and the next byte has a count of the string length.
!	Otherwise, the field is a longword (4 bytes).  We care about
!	the LAT$_ITM_TARGET_NODE_NAME and LAT$_ITM_TARGET_PORT_NAME
!	fields.  But since the item codes are words and sometimes they
!	describe strings and sometimes longwords, the only way we can
!	find the fields we care about is to scan the whole string until
!	we find what we want.  I would HATE to have to make this thing
!	align nicely for an AXP system!

	I = 1
	! I is a pointer to our position in the LAT_BUFFER string.

2100	IF (I .GE. IOSB_WORD(3)) THEN
		! We went thru the whole thing without finding what we want.
		TYPE *, 'Problem decoding LAT_BUFFER.'
		GOTO 99000
	END IF

	ITEM_CODE_STRING = LAT_BUFFER(I:I+1)

D	TYPE *, 'ITEM_CODE_STRING is ', ITEM_CODE_STRING
D	TYPE *, 'ITEM_CODE_WORD is ', ITEM_CODE_WORD
D	TYPE *, 'LAT$V_STRING is ', LAT$V_STRING
D	TYPE *, 'BITEST(ITEM_CODE_WORD, LAT$V_STRING) is '
D	1		, BITEST(ITEM_CODE_WORD, LAT$V_STRING)

	IF (.NOT. BITEST(ITEM_CODE_WORD, LAT$V_STRING)) THEN
		! This field isn't a string (therefore it's a longword) so
		! skip it; we don't care about this field
		I = I + 2+4 ! Move the pointer past the item code and longword.
		GOTO 2100
	END IF

	!
	! The field is a string
	!
	I = I + 2	! Move the pointer past the 2 byte item code.
	LENGTH = LAT_BUFFER_BYTE(I)
	I = I + 1	! Now move the pointer past the length count byte.

	IF (ITEM_CODE_WORD .EQ. LAT$_ITM_TARGET_NODE_NAME) THEN
		! We found the server name so go handle it.
		GOTO 3000
	END IF

	IF (ITEM_CODE_WORD .EQ. LAT$_ITM_TARGET_PORT_NAME) THEN
		! We found the port name so go handle it.
		GOTO 4000
	END IF

	I = I + LENGTH
	GOTO 2100

!
!	This field is the node name.  It comes before the port name in the
!	buffer.  Set the SERVER symbol and go look for the port name.
!
3000	SERVER_NAME = LAT_BUFFER(I : I + LENGTH-1)
	STATUS = LIB$SET_SYMBOL(%DESCR('SERVER')	! Symbol
	1	, %DESCR(SERVER_NAME(1:LENGTH))		! Value string
	1	, %REF(1))				! Table type indicator
	IF (.NOT. STATUS) THEN
		CALL LIB$SIGNAL(%VAL(STATUS))
		GOTO 99000
	END IF

	I = I + LENGTH
	GOTO 2100

!
!	This field is the port name.  It comes after the node name in the
!	buffer.  Set the PORT symbol and we're done.  We don't care about
!	anything after this field.
!
4000	PORT_NAME = LAT_BUFFER(I : I + LENGTH-1)
	STATUS = LIB$SET_SYMBOL(%DESCR('PORT')		! Symbol
	1	, %DESCR(PORT_NAME(1:LENGTH))		! Value string
	1	, %REF(1))				! Table type indicator
	IF (.NOT. STATUS) THEN
		CALL LIB$SIGNAL(%VAL(STATUS))
		GOTO 99000
	END IF

!
!	Close down the I/O channel
!
99000	STATUS = SYS$DASSGN(%VAL(CHN))		! Channel number

99899	FORMAT (I8)
99900	WRITE (UNIT = STATUS_STRING, FMT = 99899) STATUS

	CALL LIB$SET_SYMBOL(%DESCR('$STATUS')		! Symbol
	1	, %DESCR(STATUS_STRING	)		! Value string
	1	, %REF(1))				! Table type indicator

99999	END




From:	IN%"eagan@beet.sca.dec.com" 19-SEP-1996 07:23:20.39
To:	IN%"MSTGIL@unt.edu", IN%"KMALLORY@us.oracle.com", IN%"TCUPP@us.oracle.com", IN%"PRUPAREL@us.oracle.com", IN%"DARYL_MASON@fmc.com", IN%"RICHARDE@microsoft.com", IN%"JOHNNORD@microsoft.com", IN%"DAVIDC@montagar.com", IN%"RLB@lanl.gov", IN%"IGOR@lanl.gov
CC:	
Subj:	Contributions for OpenVMS V3 Freeware CD?.

Return-path: <eagan@beet.sca.dec.com>
Received: from mail11.digital.com (mail11.digital.com)
 by STTHOMAS.EDU (PMDF V5.0-6 #12108) id <01I9NKYKINJ48YCX7Y@STTHOMAS.EDU> for
 DGSCOTT@STTHOMAS.EDU; Thu, 19 Sep 1996 07:23:19 -0600 (CST)
Received: from beet by mail11.digital.com (8.7.5/UNX 1.2/1.0/WV)
 id IAA21509; Thu, 19 Sep 1996 08:14:36 -0400 (EDT)
Date: Thu, 19 Sep 1996 07:11:31 -0500
From: eagan@beet.sca.dec.com (Brendan (972) 702.4127 or DTN 483.4127)
Subject: Contributions for OpenVMS V3 Freeware CD?.
To: MSTGIL@unt.edu, KMALLORY@us.oracle.com, TCUPP@us.oracle.com,
 PRUPAREL@us.oracle.com, DARYL_MASON@fmc.com, RICHARDE@microsoft.com,
 JOHNNORD@microsoft.com, DAVIDC@montagar.com, RLB@lanl.gov, IGOR@lanl.gov,
 74651.2467@compuserve.com, CHURCH@vs.lmco.com, LKLOP@vs.lmco.com,
 BOURQUE@vs.lmco.com, DANDKCOX@aol.com, 6477282@mcimail.com,
 JGORAK@mcimail.com, DGSCOTT@STTHOMAS.EDU, LITO@oasys.dt.navy.mil,
 RICHARD-SPILLER@tamu.edu, GARSIDEKN@lfwc.lockheed.com,
 DENTON@orison.dsserv.com, HAYES@onramp.net, GPI@onramp.net, WYLE@airmail.net,
 DRABICKY@plano.net, DBURGER@computek.net, STEVE@symark.com,
 RICHARD.COCHRAN@telops.gte.com, CURTIS.J.EYRE@gte.sprint.com,
 DAVID.C.WANG@gte.sprint.com, CRENSHAW@lobby.ti.com, RLSCOTT@lobby.ti.com,
 WARTHOG@netcom.com, HEFFNER@pennington.com, USTK6BZB@ibmmail.com,
 KOZAKS@hillwpos.hill.af.mil, FISCHER@whmc-lafb.af.mil, OGAWA@whmc-lafb.af.mil,
 DAVIDSON@trump.itg.ti.com, ALLEN@cse.uta.edu, GRAHAM@dseg.ti.com,
 HOLSTON@dseg.ti.com, CHRISMAN@post.cis.smu.edu, DJONES@post.cis.smu.edu
Message-id: <96091907113169@beet.sca.dec.com>
X-VMS-To: @cust2
Content-transfer-encoding: 7BIT

edu
	The third OpenVMS Freeware CD is being assembled.  If you
	have contributions, would you please contact either:

everhart@star.enet.dec.com		! Glenn Everhart
					! or
tavares@star.enet.dec.com		! Joe Tavares

	Thanks!

Regards


        /*******************************************************\
        * Brendan Eagan           Digital Equipment Corporation *
        * Consultant              4851 LBJ Freeway, Suite 1100  *
        * eagan@beet.sca.dec.com  Dallas, Texas  75244-8198     *
        * Voice  972.702.4127     FAX  972.702.4209             *
        \*******************************************************/

% ====== Internet headers and postmarks (see DECWRL::GATEWAY.DOC) ======
% Received: from mail11.digital.com by us2rmc.zko.dec.com (5.65/rmc-22feb94) id AA23675; Thu, 19 Sep 96 16:09:48 -0400
% Received: from stthomas.edu by mail11.digital.com (8.7.5/UNX 1.2/1.0/WV) id NAA07515; Thu, 19 Sep 1996 13:28:56 -0400 (EDT)
% Received: from STTHOMAS.EDU by STTHOMAS.EDU (PMDF V5.0-6 #12108) id <01I9NUZIW97A8YCVFV@STTHOMAS.EDU>; Thu, 19 Sep 1996 12:28:51 -0600 (CST)
% Date: Thu, 19 Sep 1996 12:28:51 -0600 (CST)
% From: "Greg Scott at the University of St. Thomas in Minnesota" <DGSCOTT@STTHOMAS.EDU>
% Subject: Re: Contributions for OpenVMS V3 Freeware CD?.
% To: eagan@beet.sca.dec.com
% Cc: star::everhart, star::tavares
% Message-Id: <01I9NUZIW97C8YCVFV@STTHOMAS.EDU>
% X-Vms-To: IN%"eagan@beet.sca.dec.com"
% X-Vms-Cc: IN%"everhart@star.enet.dec.com", IN%"tavares@star.enet.dec.com",DGSCOTT
% Mime-Version: 1.0
% Content-Type: TEXT/PLAIN; CHARSET=US-ASCII
% Content-Transfer-Encoding: 7BIT
