LIB_FAO and LIB_FAOL, part 2

In the previous article, we introduced the FAO service. In this article, we will examine the code that implements FAO for UOS.

function SYS_FAO( ctrstr, OutLen, OutBuf : int64 ; 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 ) : int64 ;

begin
    Result := LIB_FAO( ctrstr, OutLen, OutBuf, P1, P2, P3, P4, P5, P6, P7, P8, P9,
        P10, P11, P12, P13, P14, P15, P16, P17 ) ;
end ;


function SYS_FAOL( ctrstr, OutLen, OutBuf, List : int64 ) : int64 ;

begin
    Result := LIB_FAOL( ctrstr, OutLen, OutBuf, List ) ;
end ;

As mentioned in the last article, the SYS unit simply redirects the FAO and FAOL system calls to starlet.

function LIB_FAO( ctrstr, OutLen, OutBuf : int64 ; 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 ) : int64 ;

var Parameters : array[ 1..17 ] of int64 ;

begin
    Parameters[ 1 ] := P1 ;
    Parameters[ 2 ] := P2 ;
    Parameters[ 3 ] := P3 ;
    Parameters[ 4 ] := P4 ;
    Parameters[ 5 ] := P5  ;
    Parameters[ 6 ] := P6 ;
    Parameters[ 7 ] := P7 ;
    Parameters[ 8 ] := P8 ;
    Parameters[ 9 ] := P9 ;
    Parameters[ 10 ] := P10 ;
    Parameters[ 11 ] := P11 ;
    Parameters[ 12 ] := P12 ;
    Parameters[ 13 ] := P13 ;
    Parameters[ 14 ] := P14 ;
    Parameters[ 15 ] := P15 ;
    Parameters[ 16 ] := P16 ;
    Parameters[ 17 ] := P17 ;
    Result := FAO( ctrstr, OutLen, OutBuf, int64( @Parameters ), True ) ;
end ;

LIB_FAO simply creates a 17-entry array and passes it and the other parameters to FAO, which is described below. It also passes True for the last parameter, meaning that there are no more than 17 parameters being passed.

function LIB_FAOL( ctrstr, OutLen, OutBuf, List : int64 ) : int64 ;

begin
    Result := FAO( ctrstr, OutLen, OutBuf, List, False ) ;
end ;

LIB_FAO simply calls FAO passing the parameters. But it also passes False as the last parameter, which indicates that we have no idea how many parameters are actually being passed.

function FAO( ctrstr, OutLen, OutBuf, Parameters : int64 ; Limit : boolean ) : int64 ;

var Control : string ;
    SRB : TSRB ;

begin
    Result := 0 ;
    if( OutBuf = 0 ) then
    begin
        exit ;
    end ;
    if( ctrstr = 0 ) then // No control string
    begin
        if( OutLen <> 0 ) then
        begin
            Pint64( OutLen )^ := 0 ;
        end ;
        exit ;
    end ;
    move( PChar( ctrstr )[ 0 ], SRB, sizeof( SRB ) ) ;
    if( ( SRB.Buffer = 0 ) or ( SRB.Length = 0 ) ) then // No control string
    begin
        if( OutLen <> 0 ) then
        begin
            Pint64( OutLen )^ := 0 ;
        end ;
        exit ;
    end ;

The first thing we do is validate the output buffer and length and exit if there is no need to continue.

    Control := _FAO_( Get_String( SRB ), Parameters, Result, Limit ) ;
    if( length( Control ) > Pint64( OutLen )^ ) then
    begin
        setlength( Control, PInt64( OutLen )^ ) ;
    end ;
    move( PChar( Control )[ 0 ], PChar( OutBuf )[ 0 ], length( Control ) ) ;
    if( OutLen <> 0 ) then
    begin
        Pint64( OutLen )^ := length( Control ) ;
    end ;
end ;

Next we call the _FAO_ function, getting the control string in the process. Upon return, we update the output buffer and length. Note that we truncate the output if it is longer than the length of the receiving buffer.

const Conditional_State_None = 0 ; // Not in a conditional
      Conditional_State_If = 1 ; // In the portion of the conditional being processed
      Conditional_State_Else = 2 ; // Waiting for else portion of conditional
      Conditional_State_End = 3 ; // Waiting for end of conditional

function _FAO_( Control : string ; var Parameters : int64 ; var Res : int64 ;
    Limit : boolean ; Nest : integer = 0 ) : string ;

var Parameter_Pointer : int64 ;
    Max_Parameter_Pointer : uint64 ;

var Last_Number : int64 ;

type TFAO = record
                Count : integer ;
                Width : integer ;
                Default_Width : integer ;
                Source_Size : integer ;
                Indirect : boolean ;
                Truncate_Right : boolean ; // False = truncate left
                Fill : char ; // Fill value
                Excess_Fill : char ; // Fill when Width > Default_Width
                Directive : string ;
            end ;

var _FAO : TFAO ;

var A : int64 ;
    Directive : string ;
    I, Loop : integer ;
    Conditional_State : integer ;
    Left_Justify : boolean ;
    S : string ;
    SRB : TSRB ;

begin
    // Setup...
    Res := 0 ;
    Parameter_Pointer := Parameters ;
    if( Limit ) then
    begin
        Max_Parameter_Pointer := Parameters + 17 * sizeof( int64 ) ;
    end else
    begin
        Max_Parameter_Pointer := $7FFFFFFFFFFFFFFF ;
    end ;
    Conditional_State := Conditional_State_None // Not in a conditional

Besides the normal variables, we have one that is of type TFAO, which contains the information on the current directive being processed. The routine starts by setting the current Parameter_Pointer to the passed Parameters pointer. If the Limit flag was passed, we set the Max_Parameter_Pointer to the current pointer plus seventeen elements. Otherwise we set it to the max possible address.

    // Process string...
    I := 1 ;
    while( I <= length( Control ) ) do
    begin
        Left_Justify := False ;
        if( Control[ I ] = '!' ) then
        begin
            if( copy( Control, I + 1, 1 ) = '!' ) then // !! construct
            begin
                if( Conditional_State < 2 ) then
                begin
                    Result := Result + '!' ;
                    I := I + 2 ;
                end ;
                continue ;
            end ;
            if( copy( Control, I + 1, 1 ) = '/' ) then // !/ construct
            begin
                if( Conditional_State < 2 ) then
                begin
                    Result := Result + CRLF ;
                    I := I + 2 ;
                end ;
                continue ;
            end ;
            if( copy( Control, I + 1, 1 ) = '_' ) then // !_ construct
            begin
                if( Conditional_State < 2 ) then
                begin
                    Result := Result + HT ;
                    I := I + 2 ;
                end ;
                continue ;
            end ;
            if( copy( Control, I + 1, 1 ) = '^' ) then // !^ construct
            begin
                if( Conditional_State < 2 ) then
                begin
                    Result := Result + FF ;
                    I := I + 2 ;
                end ;
                continue ;
            end ;
            if( copy( Control, I + 1, 1 ) = '-' ) then // !- construct
            begin
                if( Conditional_State < 2 ) then
                begin
                    Parameter_Pointer := Parameter_Pointer - sizeof( int64 ) ;
                    I := I + 2 ;
                end ;
                continue ;
            end ;
            if( copy( Control, I + 1, 1 ) = '+' ) then // !+ construct
            begin
                if( Conditional_State < 2 ) then
                begin
                    Parameter_Pointer := Parameter_Pointer + sizeof( int64 ) ;
                    I := I + 2 ;
                end ;
                continue ;
            end ;
            if( copy( Control, I + 1, 1 ) = '>' ) then // !> construct
            begin
                if( Conditional_State < 2 ) then
                begin
                    if( Nest > 0 ) then
                    begin
                        exit ;
                    end ;
                    I := I + 2 ;
                end ;
                continue ;
            end ;

The I variable serves as our index into the control string. We set it to the first character and then loop until our index reaches the end of the string. As we loop, the first thing we do is clear the Left_Justify flag. Then we check for an exclamation point, indicating a possible directive. We check for the special cases. If found, we insert the appropriate value into the output, then adjust the index value and continue to the next iteration of the loop.

            Parse_Directive( I ) ;
            if( ( Nest > 0 ) and ( Conditional_State < 2 ) ) then
            begin
                _FAO.Fill := ' ' ;
                _FAO.Truncate_Right := False ;
            end ;

Next we call the Parse_Directive procedure to parse the next directive. If we are nested (inside a !n< !> directive pair), and within a conditional, we set the fill to space and the Truncate_Right to left-fill. Conditional_State indicates if we're in a conditional and where within it we are. Note that Parse_Directive advances the index past the directive.

            if( _FAO.Directive = '%C' ) then
            begin
                if( Last_Number = _FAO.Width ) then
                begin
                    Conditional_State := Conditional_State_If ; // In conditional
                end else
                begin
                    Conditional_State := Conditional_State_Else ; // Look for else
                end ;
                continue ;
            end else
            if( _FAO.Directive = '%E' ) then
            begin
                if( Conditional_State = Conditional_State_Else ) then // Looking for else
                begin
                    Conditional_State := Conditional_State_If ; // In the conditional now
                end else
                begin
                    Conditional_State := Conditional_State_End ; // Skip to finish
                end ;
                continue ;
            end else
            if( _FAO.Directive = '%F' ) then // Completed the conditional
            begin
                Conditional_State := Conditional_State_None ;
                continue ;
            end ;
            if( Conditional_State > Conditional_State_If ) then
            begin
                continue ;
            end ;

If the directive is a conditional (!%C), we need to see if the conditional value is equal to the last number. Because of the way directives are parsed, the conditional value is parsed as the directive width. So we compare the last number with the "width". If it is equal, we set the conditional state to Conditional_State_If, which means we want to process everything up to the !%E or !%F directive. If the conditional value is not equal, we set the state to Conditional_State_Else to skip everything until the !%E or !%F directive.
If the directive is the else (!%E), then if we're in the processing state, we change the state to Conditional_State_End to skip until the !%F directive. If we are in the state to wait until the else, we set the state to Conditional_State_If to process the following text.
If the directive is the end of the conditional (!%F), we are done with the conditional and set the state to Conditional_State_None. Note that an extra !%F directive will simply be ignored.
Once we're done with any potential conditional directives, we see if we are awaiting an else or end directive. If so, we skip to the next position in context.

            while( _FAO.Count > 0 ) do
            begin
                dec( _FAO.Count ) ;
                S := '' ;
                if( _FAO.Directive = '%U' ) then
                begin
                    _FAO.Directive := 'UL' ;
                end ;
                if( _FAO.Directive = '<' ) then
                begin
                    S := Ending_Nest_Directive( I ) ;
                    S := _FAO_( S, Parameter_Pointer, Res, Limit, Nest + 1 ) ;
                    Left_Justify := True ;
                end else

We now loop for as many times as the directive had a count. First thing we do in the loop, we decrement the count. As mentioned in the last article, the %U directive is converted to a !UL directive. S is set to the value to insert into the output string at the end of the loop.
If the directive is !n<, we look for the !> directive and grab that portion of the control string. We advanced the index to that point and then recursively call _FAO_ with the substring, passing the current nest value, plus one, so that the routine knows that it is nested.

                if( copy( _FAO.Directive, 1, 1 ) = '*' ) then
                begin
                    S := copy( _FAO.Directive, 2, 1 ) ;
                    if( S = '' ) then
                    begin
                        S := ' ' ;
                    end ;
                    S := Repeating_String( S[ 1 ], _FAO.Width ) ;
                end else
                if( _FAO.Directive = '%D' ) then // System Date/Time
                begin
                    S := ASCTIM( Get_Item( _FAO.Indirect ), 1 ) ;
                end else
                if( _FAO.Directive = '%I' ) then // Identifier for UIC
                begin
                    S := GETNAME( Get_Item( _FAO.Indirect ) ) ;
                end else

In the case of the !n* directive, we create a repeated string of the specified character. Note that, again, the count is parsed as a width. In the case of !%D, we get the time string. For !%I, we get the name associated with the UIC. Get_Item returns the next parameter value. We'll cover it later in the article.

                if( _FAO.Directive = '%S' ) then
                begin
                    if( Last_Number = 1 ) then
                    begin
                        if( pos( copy( Result, length( Result ), 1 ), 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' ) > 0 ) then
                        begin
                            S := 'S' ;
                        end else
                        begin
                            S := 's' ;
                        end ;
                    end ;
                end else

In the case of !%S, we check to see if the last number is 1. If so, we look at the previous character. If it was an uppercase letter, we insert "S", otherwise we insert "s".

                if( _FAO.Directive = '%T' ) then // System Time
                begin
                    S := ASCTIM( Get_Item( _FAO.Indirect ) ) ;
                end else
                if( _FAO.Directive = 'AC' ) then
                begin
                    S := Get_Counted_String ;
                end else
                if( _FAO.Directive = 'AD' ) then
                begin
                    S := Get_String_From_Address ;
                end else
                if( _FAO.Directive = 'AF' ) then
                begin
                    S := Get_String_From_Address ;
                    for Loop := 1 to length( S ) do
                    begin
                        if( S[ Loop ] < ' ' ) then
                        begin
                            S[ Loop ] := '.' ;
                        end ;
                    end ;
                end else

We'll look at the functions being called in a bit. Of particular interest here is the processing of the !AF directive. We get the string via the Get_String_From_Address function. Then we iterate through the characters, replacing anything less than ASCII value 32 with a period (.).

                if( _FAO.Directive = 'AB' ) then
                begin
                    S := Get_String( PSRB( Get_Item( False ) )^ ) ;
                end else
                if( _FAO.Directive = 'AS' ) then
                begin
                    S := Get_ASCID ;
                end else
                if( _FAO.Directive = 'AZ' ) then
                begin
                    S := Get_ASCIZ ;
                end else
                if( copy( _FAO.Directive, 1, 1 ) = 'B' ) then
                begin
                    S := Get_Binary( _FAO.Source_Size, _FAO.Indirect ) ;
                end else
                if( copy( _FAO.Directive, 1, 1 ) = 'O' ) then
                begin
                    S := Get_Octal( _FAO.Source_Size, _FAO.Indirect ) ;
                end else
                if( copy( _FAO.Directive, 1, 1 ) = 'X' ) then
                begin
                    S := Get_Hex( _FAO.Source_Size, _FAO.Indirect ) ;
                end else
                if( ( copy( _FAO.Directive, 1, 1 ) = 'Z' ) or
                    ( copy( _FAO.Directive, 1, 1 ) = 'U' ) or
                    ( copy( _FAO.Directive, 1, 1 ) = 'S' ) ) then
                begin
                    S := Get_Decimal( _FAO.Source_Size, _FAO.Indirect, copy( _FAO.Directive, 1, 1 ) = 'S' ) ;
                    if( ( _FAO.Width > 0 ) and ( length( S ) > _FAO.Width ) ) then
                    begin
                        S := Repeating_String( '*', _FAO.Width ) ;
                    end ;
                end else
                begin
                    S := '' ;
                end ;

This code processes the remainder of the directives. For the various decimal integer values, we get the value. If the width was specified and the number takes more space than that, we set the result to a number of asterisks equal to the directive width. If we don't recognize the directive, we set the result to null.

                while( length( S ) < _FAO.Default_Width ) do
                begin
                    if( ( Nest > 0 ) or Left_Justify ) then
                    begin
                        S := S + _FAO.Fill ;
                    end else
                    begin
                        S := _FAO.Fill + S ;
                    end ;
                end ;

Once we've processed the directives, S contains the string to insert. If the length of the string is less than the default width, we pad it with the fill character. Depending upon the Left_Justify value we decide whether to pad on the left or the right. If we are nested within a !n< and !>, we also pad on the left.

                if( ( length( S ) > _FAO.Width ) and ( _FAO.Width > 0 ) ) then
                begin
                    if( _FAO.Truncate_Right ) then
                    begin
                        setlength( S, _FAO.Width ) ;
                    end else
                    begin
                        delete( S, 1, length( S ) - _FAO.Width ) ;
                    end ;
                end ;

If the length of the result is wider than the explicitly-specified width, we truncate it. _FAO.Truncate_Right determines if we truncate on the left or right.

                while( length( S ) < _FAO.Width ) do
                begin
                    if( _FAO.Truncate_Right or Left_Justify ) then
                    begin
                        S := S + ' ' ;
                    end else
                    begin
                        S := _FAO.Excess_Fill + S ;
                    end ;
                end ; // while( length( S ) < _FAO.Width )
                Result := Result + S ;
            end ; // while( _FAO.Count > 0 ) do

Finally, if the length of the result is less than the explicit width, we pad it on the appropriate side. Then we add the adjusted value to the output.

        end else
        begin
            if( Conditional_State < Conditional_State_Else ) then
            begin
                Result := Result + Control[ I ] ;
            end ;
            inc( I ) ;
        end ;
    end ; // while( I <= length( Control ) )
end ; // _FAO_

If we aren't processing a directive, we add the character to the output buffer. But only if we aren't in a conditional state waiting for the else or ending. Then we increment the index and loop back. When we reach the end of the control string, we drop out of the loop with Result being the final output.

    function Get_Item( Indirect : boolean ) : int64 ;

    begin
        Result := 0 ;
        if( ( Parameters <> 0 ) and ( Parameters <= Max_Parameter_Pointer ) ) then
        begin
            Result := pint64( Parameter_Pointer )^ ;
            if( Indirect ) then
            begin
                Result := pint64( Result )^ ;
            end ;
            Parameter_Pointer := Parameter_Pointer + sizeof( int64 ) ;
        end ;
    end ;

This local function obtains the next parameter. It pulls from the parameter array and returns the value. If Indirect is true, we use the parameter as an address. In either case, we return the value. However, if the current parameter address is after the max pointer, that means we've run out of parameters (if called via FAO rather than FAOL). If we get a parameter, we increment the pointer to the next parameter.

    function Get_Counted_String : string ;

    var L : byte ;
        P : int64 ;

    begin
        Result := '' ;
        P := Get_Item( False ) ;
        if( P <> 0 ) then
        begin
            L := pbyte( P )^ ;
            setlength( Result, L ) ;
            move( PChar( P )[ 1 ], pchar( Result )[ 0 ], L ) ;
        end ;
    end ;


    function Get_String_From_Address : string ;

    var L, S : int64 ;

    begin
        Result := '' ;
        L := Get_Item( False ) ;
        S := Get_Item( False ) ;
        if( ( L <> 0 ) and ( S <> 0 ) ) then
        begin
            setlength( Result, L ) ;
            move( pchar( S )[ 0 ], pchar( Result )[ 0 ], L ) ;
        end ;
    end ;


    function Get_ASCID : string ;

    var Descriptor : TDescriptor ;
        P : int64 ;

    begin
        Result := '' ;
        P := Get_Item( False ) ;
        if( P <> 0 ) then
        begin
            move( PChar( P )[ 0 ], Descriptor, sizeof( Descriptor ) ) ;
            if( ( Descriptor.Length > 0 ) and ( Descriptor.Address <> 0 ) ) then
            begin
                setlength( Result, Descriptor.Length ) ;
                move( PChar( Descriptor.Address )[ 0 ], PChar( Result )[ 0 ], length( Result ) ) ;
            end ;
        end ;
    end ;


    function Get_ASCIZ : string ;

    var P : int64 ;

    begin
        Result := '' ;
        P := Get_Item( False ) ;
        if( P <> 0 ) then
        begin
            Result := PChar( P ) ;
        end ;
    end ;

These local functions obtain different species of strings. The counted strings are those whose first byte contains the number of following bytes in the string. The ASCID string uses a string descriptor. ASCIZ are null-terminated strings. The remaining strings consist of two parameter values: the length and the pointer to the string text.

    function Get_Binary( Size : integer ; Indirect : boolean ) : string ;

    var P : int64 ;

    begin
        P := Get_Item( Indirect ) ;
        Last_Number := 0 ;
        move( P, Last_Number, Size ) ;
        Result := CVTB( 10, 2, inttostr( Last_Number ) ) ;
    end ;


    function Get_Octal( Size : integer ; Indirect : boolean ) : string ;

    var P : int64 ;

    begin
        P := Get_Item( Indirect ) ;
        Last_Number := 0 ;
        move( P, Last_Number, Size ) ;
        Result := CVTB( 10, 8, inttostr( Last_Number ) ) ;
    end ;


    function Get_Hex( Size : integer ; Indirect : boolean ) : string ;

    var P : int64 ;

    begin
        P := Get_Item( Indirect ) ;
        Last_Number := 0 ;
        move( P, Last_Number, Size ) ;
        Result := CVTB( 10, 16, inttostr( Last_Number ) ) ;
    end ;

These local functions obtain an integer value via Get_Item and then convert the value to a string representing that value in the requested base.

    function Get_Decimal( Size : integer ; Indirect, Signed : boolean ) : string ;

    var P : int64 ;
        R : packed record
               case byte of
                 0 : ( int8 : shortint ) ;
                 1 : ( uint8 : byte ) ;
                 2 : ( int16 : smallint ) ;
                 3 : ( uint16 : word ) ;
                 4 : ( int32 : longint ) ;
                 5 : ( uint32 : cardinal ) ;
                 7 : ( _int64 : int64 ) ;
                 8 : ( _uint64 : uint64 ) ;
            end ;

    begin
        R._int64 := Get_Item( Indirect ) ;
        Last_Number := 0 ;
        move( R._int64, Last_Number, Size ) ;
        if( Signed ) then
        begin
            case Size of
                1 : Result := inttostr( R.int8 ) ;
                2 : Result := inttostr( R.int16 ) ;
                4 : Result := inttostr( R.int32 ) ;
                8 : Result := inttostr( Last_Number ) ;
            end ;
        end else
        begin
            if( Size = 8 ) then
            begin
                Result := inttostr( R._uint64 ) ;
            end else
            begin
                Result := inttostr( Last_Number ) ;
            end ;
        end ;
    end ;

The function to get a decimal value is complicated by the fact that we have to handle both signed and unsigned values. I could have written code to extend the sign on an otherwise unsigned value, but decided to go with a structure with a union and just get the appropriate value when a signed value was needed, since that is simpler and somewhat faster.

    procedure Parse_Directive( var I : integer ) ;

    var Starting, Ending : integer ;

    begin // Parse_Directive
        // Setup...
        Starting := I ;
        Ending := I ;
        _FAO.Count := 1 ;
        _FAO.Default_Width := 0 ;
        _FAO.Width := -1 ;
        _FAO.Source_Size := 0 ;
        _FAO.Indirect := False ;
        _FAO.Truncate_Right := False ;
        _FAO.Fill := ' ' ; // Blank fill
        _FAO.Excess_Fill := ' ' ;
        _FAO.Directive := '' ;

The local Parse_Directive function is used to parse a directive from the control string and fill the _FAO structure. The current position in the control string is passed to the function. The first thing we do is initialize the structure. If the Width is -1 when we're done, it indicates that the width is the default. The Ending value indicates the last valid character offset of the directive, so we update it as we parse through the string.

    // Handle width...
    Process_Width ;

    // Handle count...
    if( copy( Control, Ending + 1, 1 ) = '(' ) then // Count + width
    begin
        _FAO.Count := _FAO.Width ;
        _FAO.Width := -1 ;
        inc( Ending ) ;
        Process_Width ;
        if( copy( Control, Ending + 1, 1 ) = '@' ) then
        begin
            inc( Ending ) ;
            _FAO.Indirect := True ;
        end ;
        _FAO.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
            inc( Ending ) ;
            _FAO.Indirect := True ;
        end ;
        _FAO.Directive := copy( Control, Ending + 1, 2 ) ;
        Ending := Ending + 2 ;
    end ;

The first thing to look for after the exclamation (!) is a number, indicating a width. The Process_Width local function checks for a width indicator. _FAO.Width will be assigned the width, if specified. Whether or not there is a width, the next thing to check for is a parenthesis. If found, we know that what was thought to be a width is actually a count. So we copy the width value to the count and set the width to -1. We then check for another width specification by calling the Process_Width function again. After that, we check for an indirection indicator (@). If found, we set the flag and advance past it. Then we grab the directive value and "eat" the closing parenthesis.
On the other hand, if there is no opening parenthesis, then we have a directive. But first, as in the case of a repeat, we check for an indirection (@). If found, we set the flag and skip past it. Then we get the directive and update the ending position.

    // Default the width...
    if( copy( _FAO.Directive, 1, 1 ) = '<' ) then
    begin
        setlength( _FAO.Directive, 1 ) ;
        dec( Ending ) ;
    end else
    if( copy( _FAO.Directive, 1, 1 ) = 'B' ) then // Binary
    begin
        _FAO.Source_Size := Get_Size( copy( _FAO.Directive, 2, 1 ) ) ;
        _FAO.Fill := '0' ;
        _FAO.Excess_Fill := '0' ;
        case _FAO.Source_Size of
            8 : _FAO.Default_Width := 64 ;
            4 : _FAO.Default_Width := 32 ;
            2 : _FAO.Default_Width := 16 ;
            1 : _FAO.Default_Width := 8 ;
        end ;
        if( _FAO.Width = -1 ) then // No width specified
        begin
            _FAO.Width := _FAO.Default_Width ;
        end ;
    end else

If the first character of the directive is "<", then we know this is a !n< construct, so we set the directive to be only the < and exit. Otherwise, if the directive starts with "B", we know it is a binary directive. We set the size from the Get_Size function which determines it from the second character of the directive. Octal, Hex, and Binary all left fill with "0", so we set the fill values. Then, based on the source size, we set the default output width. Finally, we set the width to the default width (for cases where the control string doesn't specify the width).

    if( copy( _FAO.Directive, 1, 1 ) = 'X' ) then // Hexadecimal
    begin
        _FAO.Source_Size := Get_Size( copy( _FAO.Directive, 2, 1 ) ) ;
        _FAO.Fill := '0' ;
        _FAO.Excess_Fill := '0' ;
        case _FAO.Source_Size of
            8 : _FAO.Default_Width := 16 ;
            4 : _FAO.Default_Width := 8 ;
            2 : _FAO.Default_Width := 4 ;
            1 : _FAO.Default_Width := 2 ;
        end ;
        if( _FAO.Width = -1 ) then // No width specified
        begin
            _FAO.Width := _FAO.Default_Width ;
        end ;
    end else

We repeat the same basic pattern for Hexadecimal directives.

    if( copy( _FAO.Directive, 1, 1 ) = 'O' ) then // Octal
    begin
        _FAO.Source_Size := Get_Size( copy( _FAO.Directive, 2, 1 ) ) ;
        _FAO.Fill := '0' ;
        _FAO.Excess_Fill := '0' ;
        case _FAO.Source_Size of
            8 : _FAO.Default_Width := 22 ;
            4 : _FAO.Default_Width := 11 ;
            2 : _FAO.Default_Width := 6 ;
            1 : _FAO.Default_Width := 3 ;
        end ;
        if( _FAO.Width = -1 ) then // No width specified
        begin
            _FAO.Width := _FAO.Default_Width ;
        end ;
    end else

And the same for octal directives.

    if( copy( _FAO.Directive, 1, 1 ) = 'Z' ) then // Zero-filled decimal
    begin
        _FAO.Source_Size := Get_Size( copy( _FAO.Directive, 2, 1 ) ) ;
        _FAO.Excess_Fill := '0' ;
    end else
    if( copy( _FAO.Directive, 1, 1 ) = 'S' ) then // Decimal
    begin
        _FAO.Source_Size := Get_Size( copy( _FAO.Directive, 2, 1 ) ) ;
    end else
    begin
        _FAO.Truncate_Right := True ; // All strings
    end ;
    I := Ending + 1 ;
    end ; // Parse_Directive

The decimal directives are easier to deal with - we simply set the source size and excess fill values. In the case of signed decimal, the blank fill is also the default fill, so we don't need to set it.
For strings, the only thing we need to do is set the Truncate_Right flag. Once we're through with the directive, we set I to the character after the last character of the directive - in other words, the next character to process from the control string.

        procedure Process_Width ;

        var I : integer ;

        begin
            if( copy( Control, Ending + 1, 1 ) = '#' ) then
            begin
                _FAO.Width := Get_Item( False ) ;
                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 ;
                _FAO.Width := strtoint( copy( Control, I + 1, Ending - I ) ) ;
            end ;
        end ;

This function parses the width, if present. If the current character is a digit, then we have a width, so we iterate through the string until a non-digit is found. We then take the digits and set the width value from them.

        function Get_Size( S : string ) : integer ;

        begin
            S := copy( _FAO.Directive, 2, 1 ) ;
            if( ( S = 'Q' ) or ( S = 'A' ) or ( S = 'H' ) or ( S = 'J' ) ) then // 8 byte
            begin
                Result := 8 ;
            end else
            if( ( S = 'L' ) or ( S = 'I' ) ) then // 4 byte
            begin
                Result := 4 ;
            end else
            if( S = 'W' ) then // 2 byte
            begin
                Result := 2 ;
            end else
            if( S = 'B' ) then // 1 byte
            begin
                Result := 1 ;
            end ;
        end ;

This simple function takes a size specifier (Q,L,W,B, etc.) and returns the number of bytes represented by it.

    function Ending_Nest_Directive( var I : integer ) : string ;

    var Loop, Nested : integer ;

    begin
        // Setup...
        Result := '' ;
        Nested := 0 ;

        // Look for directive...
        Loop := I + 1 ;
        while( Loop <= length( Control ) ) do
        begin
            if( Control[ Loop ] = '!' ) then
            begin
                 if( copy( Control, Loop + 1, 1 ) = '>' ) then
                 begin
                     dec( Nested ) ;
                     if( Nested < 1 ) then
                     begin
                         break ;
                     end ;
                 end else
                 if( pos( copy( Control, Loop + 1, 1 ), '1234567890' ) > 0 ) then
                 begin
                     while(
                            ( Loop <= length( Control ) )
                            and
                            ( pos( copy( Control, Loop + 1, 1 ), '1234567890' ) > 0 )
                          ) do
                     begin
                         inc( Loop ) ;
                     end ;
                     if( copy( Control, Loop, 1 ) = '<' ) then // Another !n< directive
                     begin
                         inc( Nested ) ;
                     end ;
                 end ;
            end ; // if( Control[ Loop ] = '!' )
            inc( Loop ) ;
        end ; // while( Loop <= length( Control ) )
        Result := copy( Control, I, Loop - I ) ;
        I := Loop + 2 ;
    end ; // Ending_Nest_Directive

Finally, this function is used to find the end of a !n< !> directive pair. Since these pairs can be nested, we can't simply look for the first closing directive. So we iterate through the string, looking for either a start or end of a pair. If a start is found, we increment the Nested value. If an end is found, we decrement the Nested value. After decrementing, if the Nested value is less than 1, we have found the matching end to the starting directive. Once found, we update the passed index and return the string encapsulated within the matched directive pair.

There's a fair bit of code, but nothing complicated. In the next article, we'll look at the UCL F$FAO lexical function.