In the previous articles we discussed the operation of FAO and the implementation of LIB_FAO. In this article, we look at the UCL lexical function F$FAO, which allows scripts to access LIB_FAO. Much of the following definition comes from the FAO description in article 91. It is excerpted here for completeness. DCL limits F$FAO to 15 parameters. UCL essentially has no limit to the number of parameters that can be used. Here is the definition of the F$FAO function.

F$FAO converts character and numeric input to character strings. Note that while DCL generates ASCII strings, in UCL this function generates UTF-8 strings.

Return Value
A string containing formatted output created from the control argument and the optional arguments.

Directives
The following directives are supported by F$FAO. String directives:

Directive	Description
!AS	string

Zero-filled numeric directives:

Directive	Description
!BB	Convert a byte value to the ASCII representation of that value in base 2.
!BW	Convert a word value to the ASCII representation of that value in base 2.
!BL	Convert a longword value to the ASCII representation of that value in base 2.
!BQ	Convert a quadword value to the ASCII representation of that value in base 2.
!OB	Convert a byte value to the ASCII representation of that value in base 8.
!OW	Convert a word value to the ASCII representation of that valud in base 8.
!OL	Convert a longword value to the ASCII representation of that valud in base 8.
!OQ	Convert a quadword value to the ASCII representation of that valud in base 8.
!XB	Convert a byte value to the ASCII representation of that value in base 16.
!XW	Convert a word value to the ASCII representation of that value in base 16.
!XL	Convert a longword value to the ASCII representation of that value in base 16.
!XQ	Convert a quadword value to the ASCII representation of that value in base 16.
!ZB	Convert a byte value to the ASCII representation of that value in base 10.
!ZW	Convert a word value to the ASCII representation of that value in base 10.
!ZL	Convert a longword value to the ASCII representation of that value in base 10.
!ZQ	Convert a quadword value to the ASCII representation of that value in base 10.

Blank-filled numeric directives:

Directive	Description
!UB	Convert an unsigned byte value to the ASCII representation of that value in base 10.
!UW	Convert an unsigned word value to the ASCII representation of that value in base 10.
!UL	Convert an unsigned longword value to the ASCII representation of that value in base 10.
!UQ	Convert an unsigned quadword value to the ASCII representation of that value in base 10.
!SB	Convert a signed byte value to the ASCII representation of that value in base 10.
!SW	Convert a signed word value to the ASCII representation of that value in base 10.
!SL	Convert a signed longword value to the ASCII representation of that value in base 10.
!SQ	Convert a signed quadword value to the ASCII representation of that value in base 10.

Other Directives:

Directive	Description
!/	Inserts a new line (carriage return and linefeed). It takes no parameters.
!_	Inserts a horizontal tab (ASCII 9). It takes no parameters.
!^	Inserts a form feed. It takes no parameters.
!!	Inserts an exclamation point. It takes no parameters
!%S	Inserts the letter S if the most recently converted numeric value is not 1. If the character before the directive is upper case, an upper case S is inserted, otherwise a lowercase s is inserted.
!%T	Inserts the system time. The parameter is the datetime stamp. If the parameter is 0, the current time is inserted.
!%U	Same as !UQ.
!%I	Converts a UIC to the account name. If an invalid UIC is specified, the directive is treated as !UQ.
!%D	Inserts the system date and time. The parameter is the timestamp. If the parameter is 0, the current date/time is inserted.
!n%C	Conditional. See discussion of conditionals below.
!%E	Else portion of conditional. See discussion of conditionals below.
!%F	End of conditional. See discussion of conditionals below.
!n<	See next directive.
!>	The preceeding directive and this one are used together to define an output field that has a width of n. Within this field are displayed all directives between the !n< and !> directives. The field is blank-filled on the right to make it n characters wide if necessary. All directives within this field are left-justified and blank-filled. Note that these can be nested.
!n*c	Repeats the character c in the output n times.
!-	Reuse the most recently used parameter value.
!+	Skip the next parameter value.

Conditionals
!%nC, !%E, and !%F are used together to insert values depending upon parameter values. This is primarily for use with plurals. The general format is:
!%nCa!%Eb!%F
If n matches the last parameter value, then a is inserted, otherwise b is inserted. Example:
!ZB !%1Cchild!%Echildren!%F
In this example, if the first parameter is 1, the output would be:
1 child
But if the first parameter is not 1, the output would be:
n children
where "n" is the value of the first parameter.

The following table illustrates how the directives interact with width and filling.

Directive Type	Default output width	When explicit width is greater than default	When explicit width is less than default
!BB	8	Right justify and blank fill	Result truncated on left
!BW	16	Right justify and blank fill	Result truncated on left
!BL	32	Right justify and blank fill	Result truncated on left
!BQ	64	Right justify and blank fill	Result truncated on left
!OB	3	Right justify and blank fill	Result truncated on left
!OW	6	Right justify and blank fill	Result truncated on left
!OL	11	Right justify and blank fill	Result truncated on left
!OQ	22	Right justify and blank fill	Result truncated on left
!HB	2	Right justify and blank fill	Result truncated on left
!HW	4	Right justify and blank fill	Result truncated on left
!HL	8	Right justify and blank fill	Result truncated on left
!HQ	16	Right justify and blank fill	Result truncated on left
Unsigned zero-filled decimal	As many characters as are necessary	Right justify and blank fill	Field completely filled with asterisks (*_
Signed or unsigned deciumal	As many characters as are necessary	Right justify and zero-filled
Strings	As many characters as in the string	Left justify and blank fill to specified length	Truncate on right

Example
$ X = F$FAO("NUMBER OF FILES: !SL",COUNT)
This would insert the numeric value of COUNT into the string at the point where "!SL" occurs. For instance, if COUNT was equal to 105, the resulting string would be "NUMBER OF FILES: 105".

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

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

var Control, Count, Directive, S : string ;
    I : integer ;
    SL : TStringList ;

var A : array of int64 ;
    Array_S, Data : string ;

var IL : TInteger_List ;
    Integer_Value, P : int64 ;

begin // Parse_FAO
    Result := False ; // Assume success

    // Get control value...
    Control := Get_Parameter( Err, Context ) ;
    if( Err <> 0 ) then
    begin
        Result := True ; // Assume error
        exit ;
    end ;

    // Process control string to see what items are used...
    SL := TStringList.Create ;
    I := 1 ;
    while( I <= length( Control ) ) do
    begin
        if( Control[ I ] = '!' ) then
        begin
            if( copy( Control, I + 1, 1 ) = '!' ) then // !! construct
            begin
                I := I + 2 ;
                continue ;
            end ;
            if( copy( Control, I + 1, 1 ) = '/' ) then // !/ construct
            begin
                I := I + 2 ;
                continue ;
            end ;
            if( copy( Control, I + 1, 1 ) = '_' ) then // !_ construct
            begin
                I := I + 2 ;
                continue ;
            end ;
            if( copy( Control, I + 1, 1 ) = '^' ) then // !^ construct
            begin
                I := I + 2 ;
                continue ;
            end ;
            if( copy( Control, I + 1, 1 ) = '-' ) then // !- construct
            begin
                I := I + 2 ;
                continue ;
            end ;
            if( copy( Control, I + 1, 1 ) = '+' ) then // !+ construct
            begin
                I := I + 2 ;
                continue ;
            end ;
            if( copy( Control, I + 1, 1 ) = '>' ) then // !> construct
            begin
                I := I + 2 ;
                continue ;
            end ;
            Parse_Directive( I ) ;
            if( Err <> 0 ) then
            begin
                exit ;
            end ;

            if( Directive = '%U' ) then
            begin
                Add_To_SL( 'i' ) ;
            end ;
            if( Directive = '%D' ) then // System Date/Time
            begin
                Add_To_SL( 'i' ) ;
            end else
            if( Directive = '%I' ) then // Identifier for UIC
            begin
                Add_To_SL( 'i' ) ;
            end else
            if( Directive = '%T' ) then // System Time
            begin
                Add_To_SL( 'i' ) ;
            end else
            if( Directive = 'AC' ) then
            begin
                Err := UCL_INVDIR ;
                exit ;
            end else
            if( Directive = 'AS' ) then
            begin
                if( Control[ I - 1 ] = ')' ) then
                begin
                    Control[ I - 2 ] := 'D' ; // Convert AS) to AD)
                end else
                begin
                    Control[ I - 1 ] := 'D' ; // Convert AS to AD
                end ;
            end else
            if( Directive = 'AF' ) then
            begin
                Err := UCL_INVDIR ;
                exit ;
            end else
            if( Directive = 'AB' ) then
            begin
                Err := UCL_INVDIR ;
                exit ;
            end else
            if( Directive = 'AZ' ) then
            begin
                Err := UCL_INVDIR ;
                exit ;
            end ;
        end else
        begin
            inc( I ) ; // Regular character
        end ;
    end ;

So, we parse through the control string, looking for directives, and then adding "s" (for string) or "i" (for integer) to the string list. I is the index into the control string. When we are done, the string list will tell us how many directives were provided and what types they expect. As we encounter directives, we check for unsupported ones and return an error if found. We will address the Parse_Directive and Add_To_SL functions in a bit.

Understand that this is not a guarantee that there won't be any errors, but it is much safer to use than DCL. I leave it as an exercise for the reader to come up with a scenario in which even UCL could have an unexpected error. Hint: one scenario has to do with the !- directive.

    // Get parameters...
    Data := '' ;
    I := 0 ;
    IL := TInteger_List.Create ; // List of offsets into Data

    S := Get_Token ;
    while( S = ',' ) do // For each parameter provided
    begin
        S := Get_Parameter( Err, Context, True ) ;
        if( Err <> 0 ) then
        begin
            IL.Free ;
            exit ;
        end ;

        if( ( I < SL.Count ) and ( SL[ I ] = 's' ) ) then
        begin
            Add( length( S ) ) ;
            IL.Add( length( A ) ) ;
            Add( length( Data ) ) ;
            Data := Data + S ;
        end else
        begin
            if( not trystrtoint64( S, Integer_Value ) ) then
            begin
                Integer_Value := 0 ;
                P := length( S ) ;
                if( P > sizeof( Integer_Value ) ) then
                begin
                    P := sizeof( Integer_Value ) ;
                end ;
                move( PChar( S )[ 0 ], Integer_Value, P ) ;
            end ; // if( I < SL.Count )
            Add( Integer_Value ) ;
        end ;
        inc( I ) ;
        S := Get_Token ;
    end ; // while( S = ',' )
    Parser.Put_Token( S ) ;

If the directive is not a string, we see if the passed argument is an integer value. If not, we treat the first eight bytes as a binary integer (or less than eight bytes if the string is shorter than that). Either way, we add the integer value to the FAO parameter list.

Next we increment the parameter index and grab the next token. If it is a comma, the loop continues to the next parameter. Otherwise, we drop out of the loop and return the token.

    // Build parameter list...
    setlength( S, sizeof( int64 ) ) ;
    setlength( Array_S, length( A ) * sizeof( int64 ) ) ;
    for I := 0 to length( A ) - 1 do
    begin
        move( A[ I ], PChar( Array_S )[ I * sizeof( int64 ) ], sizeof( int64 ) ) ;
    end ;

    // Execute the call...
    Context := FAOL( Control, int64( @PChar( Array_S )[ 0 ] ) ) ;
end ; // Parse_FAO

With the string buffer and parameter list built, we now call FAOL to process the control string. We will address the FAOL function later in this article.

procedure Parse_Directive( var I : integer ) ;

var Starting, Ending, Width : integer ;

begin // Parse_Directive
    // Setup...
    Starting := I ;
    Ending := I ;
    Directive := '' ;
    Count := 1 ;

    // Handle width...
    Process_Width ;

    // Handle count...
    if( copy( Control, Ending + 1, 1 ) = '(' ) then // Count + width
    begin
        inc( Ending ) ;
        Count := Width ;
        Process_Width ;
        if( copy( Control, Ending + 1, 1 ) = '@' ) then
        begin
            Err := UCL_INVDIR ;
            exit ;
        end ;
        Directive := copy( Control, Ending + 1, 2 ) ;
        Ending := Ending + 2 ;
        if( copy( Control, Ending + 1, 1 ) = ')' ) then
        begin
            inc( Ending ) ;
        end ;
    end else
    begin
        if( copy( Control, Ending + 1, 1 ) = '@' ) then
        begin
            Err := UCL_INVDIR ;
            exit ;
        end ;
        Directive := copy( Control, Ending + 1, 2 ) ;
        Ending := Ending + 2 ;
    end ;

    // Default the width...
    if( copy( Directive, 1, 1 ) = '<' ) then
    begin
        setlength( Directive, 1 ) ;
        dec( Ending ) ;
    end else
    if( copy( Directive, 1, 1 ) = 'B' ) then // Binary
    begin
        Add_To_SL( 'i' ) ;
    end else
    if( copy( Directive, 1, 1 ) = 'X' ) then // Hexadecimal
    begin
        Add_To_SL( 'i' ) ;
    end else
    if( copy( Directive, 1, 1 ) = 'O' ) then // Octal
    begin
        Add_To_SL( 'i' ) ;
    end else
    if( copy( Directive, 1, 1 ) = 'Z' ) then // Zero-filled decimal
    begin
        Add_To_SL( 'i' ) ;
    end else
    if( copy( Directive, 1, 1 ) = 'S' ) then // Decimal
    begin
        Add_To_SL( 'i' ) ;
    end else
    if( copy( Directive, 1, 1 ) = 'A' ) then // String
    begin
        Add_To_SL( 's' ) ;
    end ;
    I := Ending + 1 ;
end ; // Parse_Directive

      procedure Process_Width ;

      var I : integer ;

      begin
          if( copy( Control, Ending + 1, 1 ) = '#' ) then
          begin
              SL.Add( 'i' ) ;
              inc( Ending ) ;
          end else
          if( pos( copy( Control, Ending + 1, 1 ), '0123456789' ) > 0 ) then
          begin
              I := Ending ;
              inc( Ending ) ;
              while( pos( copy( Control, Ending + 1, 1 ), '0123456789' ) > 0 ) do
              begin
                  inc( Ending ) ;
              end ;
              Width := strtoint( copy( Control, I + 1, Ending - I ) ) ;
          end ;
      end ;

procedure Add_To_SL( const S : string ) ;

begin
    while( Count > 0 ) do
    begin
        dec( Count ) ;
        SL.Add( S ) ;
    end ;
end ;


procedure Add( I : int64 ) ;

begin
    setlength( A, length( A ) + 1 ) ;
    // Append I to end of array A
    A[ length( A ) - 1 ] := I ;
end ;

function FAO( Control : string ; P1 : int64 = 0 ;
    P2 : int64 = 0 ; P3 : int64 = 0 ; P4 : int64 = 0 ; P5 : int64 = 0 ;
    P6 : int64 = 0 ; P7 : int64 = 0 ; P8 : int64 = 0 ; P9 : int64 = 0 ;
    P10 : int64 = 0 ; P11 : int64 = 0 ; P12 : int64 = 0 ; P13 : int64 = 0 ;
    P14 : int64 = 0 ; P15 : int64 = 0 ; P16 : int64 = 0 ; P17 : int64 = 0 ) : string ;

var OutLen : int64 ;
    SRB : TSRB ;

begin
    Set_String( Control, SRB ) ;
    setlength( Result, length( Control ) ) ;
    while( True ) do
    begin
        OutLen := length( Result ) ;
        LIB_FAO( int64( @SRB ), int64( @OutLen ), int64( Pchar( Result ) ), P1, P2,
            P3, P4, P5, P6, P7, P8, P9, P10, P11, P12, P13, P14, P15, P16, P17 ) ;
        if( OutLen < length( Result ) ) then // Result fit in our buffer
        begin
            Setlength( Result, OutLen ) ;
            exit ;
        end else
        begin
            setlength( Result, length( Result ) * 2 ) ;
        end ;
    end ;
end ;


function FAOL( Control : string ; Parameters : int64 = 0 ) : string ;

var OutLen : int64 ;
    SRB : TSRB ;

begin
    Set_String( Control, SRB ) ;
    setlength( Result, length( Control ) ) ;
    while( True ) do
    begin
        OutLen := length( Result ) ;
        LIB_FAOL( int64( @SRB ), int64( @OutLen ), int64( Pchar( Result ) ), Parameters ) ;
        if( OutLen < length( Result ) ) then // Result fit in our buffer
        begin
            Setlength( Result, OutLen ) ;
            exit ;
        end else
        begin
            setlength( Result, length( Result ) * 2 ) ;
        end ;
    end ;
end ;

In both functions, we make a call the the LIB routine in a loop. We need to have a result buffer that is large enough for the processed string. However, we would have to implement the complete FAO service here to know what the length of the final result is. To avoid that, we start with a result buffer that is the length of the control string. If the result length is shorter than that, we're done and we can return the result and exit. Otherwise, we double the size of the result buffer and try again. This continues until the result size is smaller than the result buffer meaning that we have the whole result in a string. We could also have addded a new call that calculated the FAO result and returned the length, then use that to size the buffer before calling FAO. Or, we could have added another result address that FAO could write the actual length to. But we want starlet to be VMS-compatible (we might add some extensions in the future). We could have written FAO as a Pascal string function that simply returned the full string (LIB_FAO could call that instead of doing the work itself). However, it is important to realize that Starlet is a language-indepedent library, so we cannot expect Pascal-compatible strings from it. Our implementation should only require two calls in most cases, which would be the same amount of overhead if we added a "get size" function that we called before making the FAO call.

Now that we're done with the articles on FAO, in the next article, we'll look at the next lexical function.