🚀 go-pugleaf

In article <1992Aug10.170858.25498@news.cs.brandeis.edu>, gorokhovsky@binah.cc.brandeis.edu writes:
> I need to get a logical from within a TPU procedure. Is there a way to do it
> other than using FILE_PARSE (which uppercases the value it gets)?  Any
> suggetsions will be appreciated.  I will summarize to the net whatever replies
> I get.

    Since this question has come up in vmsnet.tpu _several_ times already,
I whipped up an example TPU$CALLUSER routine (in Fortran) to interface 
directly to the $TRNLNM system service.  The source is appended below my 
signature.  Read the comments at the beginning of the source for restriction
and suggested extensions (this was supposed to be just an _example_ ;-).
Also contained in the comments are directions for compiling, linking and
using this with EVE.

    If anyone takes the time to develop this into a really robust version,
I would appreciate getting the improved copy back from you.  Otherwise,
use and enjoy!

		Cheers, Ken
-- 
 Dr. Kenneth H. Fairfield    |  Internet: Fairfield@Slacvx.Slac.Stanford.Edu
 SLAC, P.O.Box 4349, MS 98   |  DECnet:   45537::FAIRFIELD (45537=SLACVX)
 Stanford, CA   94309        |  BITNET    Fairfield@Slacvx
 ----------------------------------------------------------------------------
 These opinions are mine, not SLAC's, Stanford's, nor the DOE's...

--------------cut/here-------TRNLNMUSER.FOR------------cut/here--------------
	SUBROUTINE TPU$CALLUSER (ICODE, INSTR, RESULT)

!++	FUNCTIONAL DESCRIPTION:
!
!	This is an exmple TPU$CALLUSER routine which provides an interface
!	to the SYS$TRNLNM system service routine for translating logical
!	names.  Only the LNM$FILE_DEV logical name table is searched, and
!	only the FIRST translation is returned for logical names which are
!	search-lists.  One would need to provide some encoding in ICODE and/or
!	INSTR in order to translate names in other tables.  Simple extensions
!	to this routine (looping on SYS$TRNLNM) could be used to fully
!	translate search-lists.
!
!	Note that if there i no translation for the given logical name,
!	or if any other error condition is returned by SYS$TRNLNM, then
!	the text of that condition code is formatted via SYS$GETMSG and
!	returned in RESULT.
!
! INPUT PARAMETERS:
!
!	ICODE	Address of a longword "code" which may be used to select
!		different functions within the TPC$CALLUSER routine.  It
!		is ignored in this example.
!
!	INSTR	Address of a character string descriptor which contains
!		the logical name to be translated.
!
! OUTPUT PARAMETERS:
!
!	RESULT  Address of a _dynamic_ character-string descriptor to receive
!		the translation of INSTR.
!
! NOTES:
!
!	Following the example in the VAXTPU reference manual, you must LINK
!	this routine into a shareable image.  Use these steps:
!
!	1) Compile this source: $ FORTRAN TRNLNMUSER
!
!	2) Create an options file, e.g., TRNLNMUSER.OPT which contain the
!	   following two lines (replace "dev:[dir]" with the actual
!	   location of the files):
!
!		dev:[dir]TRNLNMUSER
!		UNIVERSAL=TPU$CALLUSER
!
!	3) Link the shareable image: $ LINK TRNLNMUSER/SHARE/OPT
!
!	4) To access this TPU$CALLUSER from EVE, before invoking EVE do:
!
!		$ DEFINE TPC$CALLUSER dev:[dir]TRNLNMUSER.EXE
!
!
! AUTHOR/DATE:		K.H. Fairfield,		10-AUG-1992
!
! E-MAIL:               Fairfield@Slacvx.Slac.Stanford.Edu
!
!--
	IMPLICIT NONE

	INCLUDE '($LNMDEF)'

	INTEGER*4 ICODE, RESULT(2)
	CHARACTER*(*) INSTR

	INTEGER*4 SYS$TRNLNM
	INTEGER*4 ISS, LLCL, LOUTSTR

	STRUCTURE /ITMLST/
	    INTEGER*2 LBUF, ITEM
	    INTEGER*4 BADR, RTLN, ZERO /0/
	END STRUCTURE
	RECORD /ITMLST/ ITMLST

	CHARACTER*256  LOCAL, OUTSTR


!+
!  SYS$TRNLNM is case-sensitive, apparently, so make a local uppercased
!  version of INSTR.
!-
	LOCAL = ' '
	CALL STR$UPCASE (LOCAL, INSTR)
	CALL STR$TRIM (LOCAL, LOCAL, LLCL)
!+
!  Get translation for INSTR.
!-
	ITMLST.LBUF = LEN (OUTSTR)
	ITMLST.ITEM = LNM$_STRING
	ITMLST.BADR = %LOC (OUTSTR)
	ITMLST.RTLN = %LOC (LOUTSTR)

	ISS = SYS$TRNLNM (,'LNM$FILE_DEV',LOCAL(1:LLCL),,ITMLST)

!+
!  If there was a problem with the translation, format the return code
!  message into OUTSTR.
!-
	IF (.NOT.ISS) THEN
	  CALL SYS$GETMSG (%VAL(ISS), LOUTSTR, OUTSTR,,)
	ENDIF

	CALL STR$GET1_DX (LOUTSTR, RESULT)
	CALL STR$COPY_DX (RESULT, OUTSTR(1:LOUTSTR))

	RETURN
	END