$!
$! --- LOGNAME.COM ---
$!
$!
$! Create shareable logical name table PROJECT_FOO.
$! 
$ SET PROCESS/PRIVILEGES=SYSPRV
$ CREATE/NAME_TABLE/PROTECTION=(S:RWED,O:RWED,G:RWE,W:R) -
        /PARENT=LNM$SYSTEM_DIRECTORY/LOG  PROJECT_FOO
$!
$!
$! Associate some ACLs with the table PROJECT_FOO.  Note: 
$! the security event alarm ACL does not work as of VMS 5.5-2.
$!
$ SET ACL/OBJECT=LOGICAL_NAME_TABLE /ACL= -
         (ID=[*,*] , ACCESS=WRITE+DELETE) PROJECT_FOO
$ SET ACL/OBJECT=LOGICAL_NAME_TABLE /ACL= -
         (ALARM_JOURNAL=SECURITY, ACCESS=WRITE+DELETE+SUCCESS) PROJECT_FOO
$!
$!
$! Look at process and system logical name table directories 
$! to see the table we just created.
$! 
$ SHOW LOGICAL/STRUCTURE
$!
$!
$! Define some logical names in table PROJECT_FOO.
$! 
$ DEFINE/TABLE=PROJECT_FOO  SAMP_LOGICAL   "ABC123"
$ DEFINE/TABLE=PROJECT_FOO  FOO$DEBUG      "ON"
$!
$!
$! Look at the logicals that we just defined
$! 
$ SHOW LOG/FULL/TABLE=PROJECT_FOO *
$!
$!
$! Check the Ada version of the sample file.  First create a
$! temporary Ada library and compile and link the files.
$! Then set the logical name FOO$DEBUG to different values and
$! run the code to see output.
$!
$ ACS CREATE LIBRARY [.TMP_ADALIB]
$ ACS SET    LIBRARY [.TMP_ADALIB]
$ ADA TRNLNM.ADA
$ ADA LOGTEST.ADA
$ ACS LINK LOGTEST
$!
$ DEFINE/TABLE=PROJECT_FOO  FOO$DEBUG      "ON"
$ RUN LOGTEST
$ DEFINE/TABLE=PROJECT_FOO  FOO$DEBUG      "OFF"
$ RUN LOGTEST
$ DEFINE/TABLE=PROJECT_FOO  FOO$DEBUG      "OOOOOOPS"
$ RUN LOGTEST
$!
$!
$! Check the FORTRAN version of the sample file.  Compile and 
$! link the file.  Then set the logical name FOO$DEBUG to 
$! different values and run the code to see output.
$!
$ FORTRAN LOGTEST.FOR
$ LINK    LOGTEST.OBJ
$ DEFINE/TABLE=PROJECT_FOO  FOO$DEBUG      "ON"
$ RUN LOGTEST
$ DEFINE/TABLE=PROJECT_FOO  FOO$DEBUG      "OFF"
$ RUN LOGTEST
$ DEFINE/TABLE=PROJECT_FOO  FOO$DEBUG      "OOOOOOPS"
$ RUN LOGTEST
$!
$!
$! Clean up.
$!
$ DEASSIGN/TABLE=LNM$SYSTEM_DIRECTORY PROJECT_FOO
$ ACS DELETE LIBRARY [.TMP_ADALIB]
$ DELETE LOGTEST.OBJ;*
$ DELETE LOGTEST.EXE;*
$!
$!
$ EXIT


        PROGRAM LOGTEST
C+
C 
C  FUNCTIONAL DESCRIPTION:
C   
C       This procedure calls the TRNLNM system service routine to
C       translate the logical name FOO$DEBUG in the logical name
C       table PROJECT_FOO.  A different message is output to the
C       screen depending on the current value of FOO$DEBUG.
C 
C   
C  FORMAL PARAMETERS:
C   
C       None.
C        
C 
C MODIFICATION HISTORY:
C 
C     Date   |     Name      | Description
C------------+---------------+-------------------------------------------------
C   01AUG92    David Greene    Initial creation.
C
C
C-
        INCLUDE '($LNMDEF)'             ! SYS$TRNLNM parameter definitions
        INCLUDE '($SSDEF)'              ! system service definitions

        STRUCTURE /ITMLST/              ! SYS$TRNLNM item-list buffer
            INTEGER*2   BUFF_LEN
            INTEGER*2   ITEM_CODE
            INTEGER*4   BUF_ADR
            INTEGER*4   RET_LEN_ADR
            INTEGER*4   END_LIST
        END STRUCTURE
        RECORD /ITMLST/   LNM_ILIST

        INTEGER*4       STATUS               ! status return value
        INTEGER*4       TRANSLATION_SIZE     ! equivalence string length
        CHARACTER*255   LOG_NAME             ! equivalence string

        LNM_ILIST.BUFF_LEN    = 255          ! max log name length
        LNM_ILIST.ITEM_CODE   = LNM$_STRING
        LNM_ILIST.BUF_ADR     = %LOC(LOG_NAME)
        LNM_ILIST.RET_LEN_ADR = %LOC(TRANSLATION_SIZE)
        LNM_ILIST.END_LIST    = 0


        CALL SYS$TRNLNM ( 0,'PROJECT_FOO','FOO$DEBUG',,LNM_ILIST )


        IF ( LOG_NAME(1:TRANSLATION_SIZE) .EQ. 'ON' ) THEN
            TYPE *, ' Now inside module LOGTEST '

        ELSE IF ( LOG_NAME(1:TRANSLATION_SIZE) .EQ. 'OFF' ) THEN
            TYPE *, ' Doing other useful work'

        ELSE
            TYPE *,  'Logical name FOO$DEBUG not set properly. '
            WRITE (6, 10) LOG_NAME
10          FORMAT (' Logname translation:      ', A<TRANSLATION_SIZE>)

        END IF

        END


with TEXT_IO;
with TRNLNM;
procedure LOGTEST is
 
-- +
--
--  FUNCTIONAL DESCRIPTION:
--
--      This procedure is an example of using the interface routine 
--      (procedure TRNLNM.ADA) to call the logical name translation 
--      system service to translate the logical name FOO$DEBUG in 
--      the shareable logical name table PROJECT_FOO.  A different 
--      message is output to the screen depending on the current 
--      value of FOO$DEBUG.
--
--
--  FORMAL PARAMETERS:
--
--      None.
--
--
-- MODIFICATION HISTORY:
--
--     Date   |     Name      | Description
--------------+---------------+-------------------------------------------------
--   01AUG92    David Greene    Initial creation.
--
--
-- -
 
    LOG_TRANSLATION   : string (1..255) := (others => ' ');
    LOGICAL_NAME      : constant string := "FOO$DEBUG";
    TABLE_NAME        : constant string := "PROJECT_FOO";
    TSIZE             : short_integer   := 0;
 
begin
    TRNLNM ( LOG_NAME          =>  LOGICAL_NAME,
             LOG_TABLE         =>  TABLE_NAME,
             TRANSLATION       =>  LOG_TRANSLATION,
             TRANSLATION_SIZE  =>  TSIZE );
 
    if (LOG_TRANSLATION( 1..integer(TSIZE)) = "ON" ) then
        TEXT_IO.PUT_LINE    ("Now inside module LOGTEST");
 
    elsif (LOG_TRANSLATION( 1..integer(TSIZE)) = "OFF" ) then
        TEXT_IO.PUT_LINE    ("Doing other useful work.");
 
    else
        TEXT_IO.PUT_LINE    ("Logical name FOO$DEBUG not set properly.");
        TEXT_IO.PUT         ("Logname translation:        ");
        TEXT_IO.PUT_LINE    (LOG_TRANSLATION( 1..integer(TSIZE)) );
    end if;
 
end LOGTEST;


with CONDITION_HANDLING;
with STARLET;
with SYSTEM;
with TEXT_IO; 
 
procedure TRNLNM  ( LOG_NAME          : in  string;
                    LOG_TABLE         : in  string;
                    TRANSLATION       : out string;
                    TRANSLATION_SIZE  : out SHORT_INTEGER ) is
-- ++
--
-- FUNCTIONAL DESCRIPTION:
--
--      This procedure provides an Ada interface to the VMS Translate
--      Logical Name system service routine.  The calling routine passes in
--      the logical name to be translated, and the logical name table in
--      which the logical name resides.  The equivalence string and its
--      length in bytes is returned.  
-- 
--      If for any reason the logical name cannot be successfully
--      translated, the translation string is set to be all ASCII
--      spaces and the equivalence string length is set to zero.
--      Additionally, an error message is output to SYS$OUTPUT.
--
-- FORMAL PARAMETERS:
--
--      LOGNAME:
--          The logical name to be translated.
--
--      LOG_TABLE:
--          The logical name table that contains the logical name.
--
--      TRANSLATION:
--          The logical name equivalence string.
--
--      TRANSLATION_SIZE:
--          The length of the logical name equivalance string in bytes.
--
--
-- MODIFICATION HISTORY:
--
--      01AUG92     David N. Greene         Initial creation.
--
--
-- --
 
    subtype SHORT_STRING is string (1..255);   -- max size of a logical name
    NAME_BUFFER     : SHORT_STRING;
    NAME_SIZE       : SHORT_INTEGER;
    RETURN_STATUS   : CONDITION_HANDLING.COND_VALUE_TYPE;
 
-- Pragma VOLATILE specifies that every read is to the variables in
-- memory, not to local copy.
 
    pragma VOLATILE (NAME_BUFFER);
    pragma VOLATILE (NAME_SIZE);
 
-- Initialized item list.  Zeros in last element indicate the end of list.
 
    ITEM_LIST   : STARLET.ITEM_LIST_TYPE (1..2) :=
        (1 => (BUF_LEN      => NAME_BUFFER'length,
               ITEM_CODE    => STARLET.LNM_STRING,
               BUF_ADDRESS  => NAME_BUFFER'address,
               RET_ADDRESS  => NAME_SIZE'address),
         2 => (BUF_LEN      => 0,
               ITEM_CODE    => 0,
               BUF_ADDRESS  => SYSTEM.ADDRESS_ZERO,
               RET_ADDRESS  => SYSTEM.ADDRESS_ZERO) );

begin
 
    STARLET.TRNLNM (                       -- call translate logname service
       STATUS => RETURN_STATUS,
       TABNAM => LOG_TABLE,
       LOGNAM => LOG_NAME,
       ITMLST => ITEM_LIST);
 
    if not CONDITION_HANDLING.SUCCESS ( RETURN_STATUS ) then
       TEXT_IO.PUT ("Bad return status: Failed to translate logical name ");
       TEXT_IO.PUT (LOG_NAME);
       TEXT_IO.NEW_LINE;
       TRANSLATION       := (others => ' ');    -- set string to spaces
       TRANSLATION_SIZE  := 0;                  -- set length to zero
 
    else                                   -- call was successful
       TRANSLATION(1..integer(NAME_SIZE)) := NAME_BUFFER(1..integer(NAME_SIZE));
       TRANSLATION_SIZE := NAME_SIZE;
    end if;
 
end TRNLNM;