This lexical function makes use of the TRNLNM system service, which uses the symbol tables, including the new features we've added in the previous article. Remember that, in UOS, symbols and logicals are the same thing, whereas in VMS they are separate. Here is the definition for F$TRNLNM.

F$TRNLNM translates a symbol name and returns the equivalence name string or the requested attributes of the specified symbol name.

Return Value
A character string containing the equivalence name or requested attribute of the symbol name. If no match is found, null is returned.

Description
F$TRNLNM uses the TRNLNM system service to translate a symbol and return the equivalence name value, or other requested data. The translation is not iterative.

You can omit optional arguments to the right of the last specified argument. Any arguments to the left can be omitted, but the comma delimiter must be included.

Examples
$ A = F$TRNLNM("a","LNM$PROCESS",,,,"NAME")
This would return the case-sensitive name of the symbol whose normalized (upper case) name is A. If A is not defined, a null string is returned.

Function_TRNLNM : begin if( Missing_Parentheses( '(' ) ) then begin exit ; end ; if( Process_TRNLNM( Err, Context ) ) then begin exit ; end ; if( Missing_Parentheses( ')' ) ) then begin exit ; end ; S := Context ; end ;

function Process_TRNLNM( var Err : integer ; var Context : string ) : boolean ;

var I : int64 ;
    AcMode, Attr, Flags, Item_Code, Index : integer ;
    CS, Item, Mode, Name, S, Table : string ;
    ItemType : TItemType ;

begin
    // Setup...
    Result := False ; // Assume no problems
    Context := '' ;

    // Get parameters...
    Name := trim( Get_Parameter( Err, Context ) ) ;
    if( Err <> 0 ) then
    begin
        exit ;
    end ;
    if( length( Name ) = 0 ) then
    begin
        exit ;
    end ;
    if( Parser.Peek = ',' ) then
    begin
        Get_Token ; // Eat comma
        Table := trim( Get_Parameter( Err, Context ) ) ;
        if( Err <> 0 ) then
        begin
            exit ;
        end ;
        if( Parser.Peek = ',' ) then
        begin
            Get_Token ; // Eat comma
            Index := Get_Numeric_Parameter( Err, Context ) ;
            if( Err <> 0 ) then
            begin
                exit ;
            end ;
            if( Parser.Peek = ',' ) then
            begin
                Get_Token ; // Eat comma
                Mode := uppercase( trim( Get_Parameter( Err, Context, True ) ) ) ;
                if( Err <> 0 ) then
                begin
                    exit ;
                end ;
                if( Parser.Peek = ',' ) then
                begin
                    Get_Token ; // Eat comma
                    CS := uppercase( trim( Get_Parameter( Err, Context, True ) ) ) ;
                    if( Err <> 0 ) then
                    begin
                        exit ;
                    end ;
                    if( Parser.Peek = ',' ) then
                    begin
                        Get_Token ; // Eat comma
                        Item := uppercase( trim( Get_Parameter( Err, Context, True ) ) ) ;
                        if( Err <> 0 ) then
                        begin
                            exit ;
                        end ;
                    end ;
                end ;
            end ;
        end ;
    end ; // if( Parser.Peek = ',' )

    // Process access mode...
    if( ( Mode = '' ) or ( Mode = 'USER' ) ) then
    begin
        Mode := 'USER' ;
        AcMode := PSL_C_USER ;
    end else
    if( Mode = 'SUPERVISOR' ) then
    begin
        AcMode := PSL_C_SUPER ;
    end else
    if( ( Mode = 'EXECUTIVE' ) or ( Mode = 'DEVICE' ) ) then
    begin
        AcMode := PSL_C_DRIVER ;
    end else
    if( Mode = 'KERNEL' ) then
    begin
        AcMode := PSL_C_KERNEL ;
    end else
    begin
        Err := UCL_IVKEYW ;
        Context := Mode ;
        exit ;
    end ;

    // Process attributes...
    Attr := LNM_M_CASE_BLIND ;
    while( CS <> '' ) do
    begin
        I := pos( ',', CS + ',' ) ;
        S := copy( CS, 1, I - 1 ) ;
        CS := copy( CS, I + 1, length( CS ) ) ;
        if( S <> '' ) then
        begin
            if( S = 'CASE_BLIND' ) then
            begin
                Attr := Attr or LNM_M_CASE_BLIND ;
            end else
            if( S = 'CASE_SENSITIVE' ) then
            begin
                Attr := Attr and not LNM_M_CASE_BLIND ;
            end else
            if( S = 'INTERLOCKED' ) then
            begin
                Attr := Attr or LNM_M_INTERLOCKED ;
            end else
            if( S = 'NONINTERLOCKED' ) then
            begin
                Attr := Attr and not LNM_M_INTERLOCKED ;
            end else
            begin
                Err := UCL_IVKEYW ;
                Context := S ;
                exit ;
            end ;
        end ;
    end ;

    // Process Item...
    ItemType := IT_String ;
    Flags := 0 ;
    if( Item = 'ACCESS_MODE' ) then
    begin
        ItemType := IT_Integer ;
        Item_Code := LNM_ACMODE ;
    end else
    if( Item = 'CLUSTERWIDE' ) then
    begin
        Flags := LNM_M_CLUSTERWIDE ;
    end else
    if( Item = 'CONCEALED' ) then
    begin
        Flags := LNM_M_CONCEALED ;
    end else
    if( Item = 'CONFINE' ) then
    begin
        Flags := LNM_M_CONFINE ;
    end else
    if( Item = 'CRELOG' ) then
    begin
        Flags := LNM_M_CRELOG ;
    end else
    if( Item = 'LENGTH' ) then
    begin
        ItemType := IT_Integer ;
        Item_Code := LNM_LENGTH ;
    end else
    if( Item = 'MAX_INDEX' ) then
    begin
        ItemType := IT_Integer ;
        Item_Code := LNM_MAX_INDEX ;
    end else
    if( Item = 'NO_ALIAS' ) then
    begin
        Flags := LNM_M_NO_ALIAS ;
    end else
    if( Item = 'TABLE' ) then
    begin
        Flags := LNM_M_TABLE ;
    end else
    if( Item = 'TABLE_NAME' ) then
    begin
        Item_Code := LNM_TABLE ;
    end else
    if( Item = 'TERMINAL' ) then
    begin
        Flags := LNM_M_TERMINAL ;
    end else
    if( Item = 'VALUE' ) then
    begin
        Item_Code := LNM_STRING ;
    end else
    if( Item = 'NAME' ) then
    begin
        Item_Code := LNM_NAME ;
    end else
    if( Item = '' ) then // Default
    begin
        Item_Code := LNM_STRING ;
    end else
    begin
        Err := UCL_IVKEYW ;
        Context := Item ;
        exit ;
    end ;

// Get value... if( Flags <> 0 ) then // Obtain a flag begin S := Get_TRNLNM( LNM_ATTRIBUTES, Attr, Table, Name, AcMode ) ; I := Get_Integer_From_String( S ) ; if( ( I and Flags ) = 0 ) then begin Context := 'FALSE' ; end else begin Context := 'TRUE' ; end ; exit ; end ;

    S := Get_TRNLNM( Item_Code, Attr, Table, Name, AcMode ) ;
    if( ItemType = IT_Integer ) then
    begin
        I := Get_Integer_From_String( S ) ;
        S := inttostr( I ) ;
        if( Item_Code = LNM_ACMODE ) then
        begin
            case I of
                PSL_C_KERNEL : S := 'KERNEL' ;
                PSL_C_EXEC : S := 'EXECUTIVE' ;
                PSL_C_SUPER : S := 'SUPERVISOR' ;
                else S := 'USER' ;
            end ;
        end ;
    end ;
    Context := S ;
end ; // Process_TRNLNM

function Get_TRNLNM( Code, attr : int64 ; tabnam, lognam : string ;
    acmode : int64 = 3 ) : string ;

var PP_SYS_Descriptor : array[ 0..1 ] of TSYS_Descriptor ;

begin
    BufLen := sizeof( Buf ) ;
    fillchar( PP_SYS_Descriptor, sizeof( PP_SYS_Descriptor ), 0 ) ;
    PP_SYS_Descriptor[ 0 ].Buffer_Length := sizeof( Buf ) ;
    PP_SYS_Descriptor[ 0 ].Item_Code := Code ; // TRNLNM item
    PP_SYS_Descriptor[ 0 ].Buffer_Address := integer( @Buf ) ;
    PP_SYS_Descriptor[ 0 ].Return_Length_Address := integer( @BufLen ) ;
    TRNLNM( Attr, Tabnam, Lognam, AcMode, integer( @PP_SYS_Descriptor ) ) ;
    setlength( Result, BufLen ) ;
    move( Buf[ 0 ], PChar( Result )[ 0 ], BufLen ) ;
end ;