1 Introduction
2 Ground Rules

Building a File System
3 File Systems
4 File Content Data Structure
5 Allocation Cluster Manager
6 Exceptions and Emancipation
7 Base Classes, Testing, and More
8 File Meta Data
9 Native File Class
10 Our File System
11 Allocation Table
12 File System Support Code
13 Initializing the File System
14 Contiguous Files
15 Rebuilding the File System
16 Native File System Support Methods
17 Lookups, Wildcards, and Unicode, Oh My
18 Finishing the File System Class

The Init Program
19 Hardware Abstraction and UOS Architecture
20 Init Command Mode
21 Using Our File System
22 Hardware and Device Lists
23 Fun with Stores: Partitions
24 Fun with Stores: RAID
25 Fun with Stores: RAM Disks
26 Init wrap-up

The Executive
27 Overview of The Executive
28 Starting the Kernel
29 The Kernel
30 Making a Store Bootable
31 The MMC
32 The HMC
33 Loading the components
34 Using the File Processor
35 Symbols and the SSC
36 The File Processor and Device Management
37 The File Processor and File System Management
38 Finishing Executive Startup

Users and Security
39 Introduction to Users and Security
40 More Fun With Stores: File Heaps
41 File Heaps, part 2
42 SysUAF
43 TUser
44 SysUAF API

Terminal I/O
45 Shells and UCL
46 UOS API, the Application Side
47 UOS API, the Executive Side
48 I/O Devices
49 Streams
50 Terminal Output Filters
51 The TTerminal Class
52 Handles
53 Putting it All Together
54 Getting Terminal Input
55 QIO
56 Cooking Terminal Input
57 Putting it all together, part 2
58 Quotas and I/O

UCL
59 UCL Basics
60 Symbol Substitution
61 UCL Command execution
62 UCL Command execution, part 2
63 UCL Command Abbreviation
64 ASTs
65 UCL Expressions, Part 1
66 UCL Expressions, Part 2: Support code
67 UCL Expressions, part 3: Parsing
68 SYS_GETJPIW and SYS_TRNLNM
69 UCL Expressions, part 4: Evaluation

UCL Lexical Functions
70 PROCESS_SCAN
71 PROCESS_SCAN, Part 2
72 TProcess updates
73 Unicode revisted
74 Lexical functions: F$CONTEXT
75 Lexical functions: F$PID
76 Lexical Functions: F$CUNITS
77 Lexical Functions: F$CVSI and F$CVUI
78 UOS Date and Time Formatting
79 Lexical Functions: F$CVTIME
80 LIB_CVTIME
81 Date/Time Contexts
82 SYS_GETTIM, LIB_Get_Timestamp, SYS_ASCTIM, and LIB_SYS_ASCTIM
83 Lexical Functions: F$DELTA_TIME
84 Lexical functions: F$DEVICE
85 SYS_DEVICE_SCAN
86 Lexical functions: F$DIRECTORY
87 Lexical functions: F$EDIT and F$ELEMENT
88 Lexical functions: F$ENVIRONMENT
89 SYS_GETUAI
90 Lexical functions: F$EXTRACT and F$IDENTIFIER
91 LIB_FAO and LIB_FAOL
92 LIB_FAO and LIB_FAOL, part 2
93 Lexical functions: F$FAO
94 File Processing Structures
95 Lexical functions: F$FILE_ATTRIBUTES
96 SYS_DISPLAY
97 UCL Lexical functions: F$GETDVI
98 Parse_GetDVI

Glossary/Index


Download sources
Download binaries

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.

 

Copyright © 2020 by Alan Conroy. This article may be copied in whole or in part as long as this copyright is included.