Lexical functions - F$MESSAGE

In this article, and the next ones, we will be covering file I/O. We've discussed files from the standpoint of a file system. But now we will look at how the File Processor component deals with file I/O. We bring this up at this point because the next (and final, for now) lexical function that we are discussing is F$MESSAGE which returns message text from a file. As we follow the code through, we will be deep diving into the FIP. Here is the definition.

F$MESSAGE returns a string containing the facility, severity, identification, and text associated with a given system status code.

Format
F$MESSAGE(code{,options})

Return Value
A character string containing the system message with the elements specified in the second argument (or all elements if the second argument is omitted).

Even though each message in the system message file has a numeric code associated with it, not every possible numeric value corresponds to a system message. If a code is specified that has no corresponding message, the function returns a string containing the NOMSG error message.

Arguments
code

A integer code specifying the error to return text for.

options

Specifies one or more message fields to include in the returned string. If no options are specified or the argument is omitted, all fields are included. More than one field can be specified by delimiting them by commas. The following field names can be specified:

Keyword Field included

FACILITY Facility name

SEVERITY Severity level indicator

IDENT Message identification code

TEXT Explanatory text of message

If the facility, severity, or ident is returned, it (or they) will be prefixed with the percent sign (%). If more than one are specified, they are delimited with dashes (-).
If only the text is included, it is not prefixed with any character. But if it is included with the facility, severity, and/or ident, the text is separated from the rest of the fields by a comma and a blank (, ).

Example
$ A = F$MESSAGE(%X0F)
This call will set the symbol A to the error message corresponding to error message 15 (0F hexadecimal). The text will include all four fields of the message.

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

This code is added to the Function_Reference function.

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

var Code : integer ;
    Elements : string ;
    Flags : int64 ;
    I : integer ;
    S : string ;

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

    // Get items...
    Code := Get_Numeric_Parameter( Err, Context ) ;
    if( Err <> 0 ) then
    begin
        exit ;
    end ;
    if( Parser.Peek = ',' ) then
    begin
        Get_Token ; // Eat comma
        Elements := lowercase( Get_Parameter( Err, Context ) ) ;
        if( Err <> 0 ) then
        begin
            exit ;
        end ;
    end ;

This new function starts like all of the other lexical function execution code we've covered in past articles. We get the parameters, the second of which is optional.

    // Process elements...
    if( Elements <> '' ) then
    begin
        I := pos( ',', Elements + ',' ) ;
        S := trim( copy( Elements, 1, I - 1 ) ) ;
        Elements := copy( Elements, I + 1, length( Elements ) ) ;
        if( S = 'facility' ) then
        begin
            Flags := Flags or 8 ;
        end else
        if( S = 'severity' ) then
        begin
            Flags := Flags or 4 ;
        end else
        if( S = 'ident' ) then
        begin
            Flags := Flags or 2 ;
        end else
        if( S = 'text' ) then
        begin
            Flags := Flags or 1 ;
        end else
        begin
            Err := UCL_IVKEYW ; // Unrecognized keyword
            Context := S ;
            exit ;
        end ;
    end ;
    if( Flags = 0 ) then
    begin
        Flags := -1 ; // Include all options
    end ;

    Context := GETMSG( Code, Flags ) ;
end ; // Parse_Message

Next we loop through all keywords specified in the second argument. For each one, we set the corresponding flag, and exit with an error if an invalid keyword is encountered. If Flags is 0, there were no fields specified, so we set all the bits to include all fields. Then we call the GETMSG function to get the value.

function GETMSG( Msg, Flags : int64 ) : string ;

var Reslen, OutAdr : int64 ;

begin
    Reslen := 0 ;
    OutAdr := 0 ;
    setlength( Result, 1024 ) ;
    SYS_GETMSG( Msg, int64( @Reslen ), int64( PChar( Result ) ), Flags, int64( @OutAdr ) ) ;
    setlength( Result, Reslen ) ;
    Result := trim( Result ) ;
end ;

This new function is added to the PasStarlet unit. It gets the result and then returns it as a Pascal string. We set the result buffer to 1K bytes length, since no system message will exceed that. Then we pass the address of that buffer (in a string) and make the system call. We then trim the result text to the returned length and return it to the caller.

procedure SYS_GETMSG( Msg, Reslen, Res, Flags, OutAdr : int64 ) ;

begin
    LIB_SYS_GETMSG( Msg, Reslen, Res, Flags, OutAdr ) ;
end ;

This function is added to the SYS unit, which simply calls LIB_SYS_GETMSG. This is another instance of where VMS puts a system service in the executive that really doesn't belong there - primarily because it does not need to be there. Thus, we handle it in Starlet.

procedure LIB_SYS_GETMSG( Msg, Reslen, Res, Flags, OutAdr : int64 ) ;

var Buffer : PAnsiChar ;
    F : TCOM_File64 ;
    Facility, Severity, Ident, Mess : string ;
    I : int64 ;
    Prefix, S : string ;

begin
    Prefix := inttostr( Msg ) + ' ' ;

    // Open message file...
    F := nil ;
    S := LIB_Get_Symbol( 'sys$language' ) ;
    if( ( S <> '' ) and ( lowercase( S ) <> 'english' ) ) then
    begin
        F := Open_Binary_File( 'sys$system:messages.' + S + '.txt', FAB_V_GET or FAB_V_SHRALL ) ;
    end ;
    if( F = nil ) then
    begin
        F := Open_Binary_File( 'sys$system:messages.txt', FAB_V_GET or FAB_V_SHRALL ) ;
    end ;
    if( F = nil ) then
    begin
        exit ;
    end ;

This function does the work of returning the specified error message. The format of the file is one line per message, starting with the integer code, a space, and the full message, including all four fields. Here are a couple lines from the file for illustration:


201 %LIB-E-INVTIM, Invalid time
202 %LIB-E-ILFORF, Unrecognized format field

We create a prefix string to compare each line, consisting of the code and a space. Then we open the message file.

To support localization, we first get the user's current language. If it is set and isn't "english", we add the language to the end of the messages filename. If that file isn't found (or the current language is english), we open the default file (which is english). If there is an error opening the file, we simply exit.

    // Look up the error code...
    S := '' ;
    while( copy( S, 1, length( Prefix ) ) <> Prefix ) do
    begin
        if( F.EOF ) then
        begin
            S := '' ;
            break ;
        end ;
        F.Readln( Buffer ) ;
        S := Ansistring( Buffer ) ;
    end ;
    F.Free ;

Next we look up the error code by reading the message file and comparing the start of each line with the prefix we constructed above. If we hit the end of the file without finding a match, we set S to null and exit the loop. The loop ends if a match is found. After the loop, S will either be null or the message text from the messages file.

    // Parse message...
    if( S = '' ) then
    begin
        S := Prefix + '%NONAME-W-NOMSG, Message number ' + Prefix ;
    end ;
    I := pos( ' ', S ) ;
    S := copy( S, I + 2, length( S ) ) ; // Strip number prefix and "%"

    I := pos( '-', S ) ;
    Facility := copy ( S, 1, I - 1 ) ;
    S := copy( S, I + 1, length( S ) ) ;
    I := pos( ', ', S ) ;
    Severity := copy( S, 1, 1 ) ;
    S := copy( S, 3, length( S ) ) ;
    I := pos( ', ', S ) ;
    Ident := copy( S, 1, I - 1 ) ;
    Mess := copy( S, I + 2, length( S ) ) ;

If no match was found in the file, we default to a NOMSG error text. Next, we trim the code number from the beginning of the string. Now, we parse each field out of the string into the appropriate string variable.

    // Build result string...
    S := '' ;
    if( ( Flags and 8 ) <> 0 ) then
    begin
        S := Facility ;
    end ;
    if( ( Flags and 4 ) <> 0 ) then
    begin
        if( S <> '' ) then
        begin
            S := S + '-' ;
        end ;
        S := S + Severity ;
    end ;
    if( ( Flags and 2 ) <> 0 ) then
    begin
        if( S <> '' ) then
        begin
            S := S + '-' ;
        end ;
        S := S + Ident ;
    end ;
    if( S <> '' ) then
    begin
        S := '%' + S ;
    end ;
    if( ( Flags and 1 ) <> 0 ) then
    begin
        if( S <> '' ) then
        begin
            S := S + ', ' ;
        end ;
        S := S + Mess ;
    end ;

Next, we use the passed flags to build up the result string. We make sure that any field other than the text is prefixed with "%" if it is the first field. We insert the appropriate delimiter, if one is needed, and the value. By the end of this process, we have the result string.

    // Write results...
    if( Res <> 0 ) then
    begin
        move( PChar( S )[ 0 ], pointer( Res )^, length( S ) ) ;
    end ;
    if( Reslen <> 0 ) then
    begin
        PInt64( Reslen )^ := length( S ) ;
    end ;
    if( OutAdr = 0 ) then
    begin
        PInt64( OutAdr )^ := 0 ;
    end ;
end ; // LIB_SYS_GETMSG

Finally, we write the result and length to the user address space.

The above code depends upon the Open_Binary_File function, which we will cover in the next article.