File Lookup Service

In preparation for a future article, we will now delve into the file lookup service in the File Processor. But first, let's delve into UOS file specification rules. There are four types of wildcards that can be used in a file specification - two of them are only valid in the path portion. The other two can be used anywhere.

Wildcard Description

* Matches 0 or more characters.

? Matches a single character.

** Only in paths. Match in all subdirectories. Any further pathing information after this wildcard is ignored.

**^ Only in paths. Refers to the parent directory.

In the case of MS Windows, "." indicates the current folder and ".." indicates the parent folder. However, since these are both valid UOS filenames, we use a different mechanism. There is no "current folder" indicator and the parent folder is indicated by the "**^" specifier. As mentioned before, the "?" wildcard takes the place of the "%" wildcard in VMS. I should note that "**^" must be the entirety of the characters between delimiting backslashes or it will be treated as the wildcard "*^". To illustrate, "\**^\" indicates subdirectories. But "\B**^A\" would be treated as the wildcard specification "\B*^A\" - that is, any directory starting with "B" and ending with "^A". Likewise with the "**" wildcard.

VMS has a feature not present on Windows, which is the ability to indicate all subdirectories in the path. Some Windows commands support this through a "/S" switch. However, like VMS, in UOS it is part of the File Processor and thus available to all programs, even those with no specific provision for it. For example, "a\**\myfile.txt" indicates "myfile.txt" in any folder under the "a" folder. This would include, for instance, "a\mydir\myfile.txt" and "a\backup\new\myfile.txt", as well as "a\myfile.txt", and so forth.

You may recall that all file system interfaces for UOS have a wildcard lookup feature, so why the need for one in the File Processor? One of the File Processor's purposes is to provide a seamless integration of all of the file systems, regardless of what they are. Because UOS handles the use of wildcards in paths, the requirements for each file system are simplified. All they need to provide is a wildcard lookup within a given directory. UOS takes care of the rest.

As with the other types of iterators we've covered before, use of this feature requires a context. Multiple contexts can be used simultaneously. The VMS file lookup system service, does the lookup and returns the filename in a single call. This can happen because of certain assumptions that VMS can make about file length and no path lists. In UOS, the return size of a found file name (which includes device and full path) is arbitrarily large. Thus, UOS has a lookup function which initializes the context the first time, or finds the next file, and returns the length of the resulting file specification rather than the name itself. Another call is made to obtain the file specification. This involves two calls to ring 0 instead of one, but the alternative is to prepare a huge buffer to hold the largest possible result string.

The approach we're going to take is recursive. We will have four classes that each deal with a different level of the file specification. We start with the device. Why do we need a class for the device level? Because if a logical device is specified which references multiple paths (as may happen with public stores), we have to deal with each device in turn. The device-level class creates a directory-level class child to iterate through the first directory in the file specification. In turn, it may create additional directory-level instances to handle subdirectories, sub-subdirectories, and so forth. At the lowest level subdiretories, a file-level instance is created to iterate through all matching files in the directory. The fourth one is a special directory-level class that deals with the ** construct.

Although it is possible to do this without recursion (and do so more efficiently in terms of CPU cycles), our approach results in much easier to understand and maintain code, which leads to less bugs. But let's start with the interface to the system service.

function Lookup( Filespec : string ; var Search_Context : int64 ) : string ;

var ResLen : int64 ;
    SRB : TSRB ;

begin
    ResLen := 0 ;
    Set_String( FileSpec, SRB ) ;
    SYS_Lookup( int64( @SRB ), int64( @Search_Context ), int64( @ResLen ) ) ;
    setlength( Result, ResLen ) ;
    if( ResLen > 0 ) then
    begin
        SYS_Lookup_Name( int64( @Search_Context ), integer( Pchar( Result ) ) ) ;
    end ;
end ;

This addition to PasStarlet takes a file specification string, converts it to a TSRB and calls the SYS_Lookup service. ResLen receives the length of the first/next matching file. The result string is set to the returned length and, if non-zero, a call is made to get the file specification.

function SYS_Lookup( SRB, Context, ResLen : int64 ) : int64 ;

var Spec : PSRB ;
    Status : int64 ;
    SysRequest : TS1I2_Request ;

begin
    Status := 0 ;
    Spec := PSRB( SRB ) ;
    fillchar( SysRequest, sizeof( SysRequest ), 0 ) ;
    SysRequest.Request.Subsystem := UOS_Subsystem_FIP ;
    SysRequest.Request.Request := UOS_FIP_Lookup ;
    SysRequest.Request.Length := sizeof( SysRequest ) - sizeof( Sysrequest.Request ) ;
    SysRequest.Request.Status := integer( @Status ) ;
    SysRequest.Integer1 := Context ;
    SysRequest.Integer2 := ResLen ;
    SysRequest.SRB.Buffer := Spec.Buffer ;
    SysRequest.SRB.Length := Spec.Length ;
    SysRequest.SRB.Flags := Spec.Flags ;

    Call_To_Ring0( integer( @SysRequest ) ) ;

    Result := Status ;
end ;

The SYS unit has the Lookup service interface. This is like code we've seen numerous times before.

function SYS_Lookup_Name( Context, Buffer : int64 ) : int64 ;

var Status : int64 ;
    SysRequest : TInteger2_Request ;

begin
    Status := 0 ;
    fillchar( SysRequest, sizeof( SysRequest ), 0 ) ;
    SysRequest.Request.Subsystem := UOS_Subsystem_FIP ;
    SysRequest.Request.Request := UOS_FIP_Lookup_Name ;
    SysRequest.Request.Length := sizeof( SysRequest ) - sizeof( Sysrequest.Request ) ;
    SysRequest.Request.Status := integer( @Status ) ;
    SysRequest.Int1 := Context ;
    SysRequest.Int2 := Buffer ;

    Call_To_Ring0( integer( @SysRequest ) ) ;

    Result := Status ;
end ;

This is the SYS unit interface for returning the file name from the last lookup operation.

function SYS_Lookup_Close( Context : int64 ) : int64 ;

var Status : int64 ;
    SysRequest : TInteger_Request ;

begin
    Status := 0 ;
    fillchar( SysRequest, sizeof( SysRequest ), 0 ) ;
    SysRequest.Request.Subsystem := UOS_Subsystem_FIP ;
    SysRequest.Request.Request := UOS_FIP_Lookup_Close ;
    SysRequest.Request.Length := sizeof( SysRequest ) - sizeof( Sysrequest.Request ) ;
    SysRequest.Request.Status := integer( @Status ) ;
    SysRequest.Int := Context ;

    Call_To_Ring0( integer( @SysRequest ) ) ;

    Result := Status ;
end ;

This is the SYS until interface to the Lookup_Close service. This is used to dispose of a file search context when the application is done with it. If not closed explicitly, it will be closed when the process terminates, but it will use additional system resources in the meantime.

UOS_FIP_Lookup:
    begin
        UE := Enter_System_Call( Request, SReq, PID, MMC, sizeof( TS1I2_Request ) - sizeof( SReq ), 
            Address ) ;
        if( UE <> nil ) then
        begin
            Set_Last_Error( UE ) ;
            exit ;
        end ;
        try
            S1I2_Request := PS1I2_Request( Address ) ;

            US := Get_User_String( Kernel, PID, S1I2_Request.SRB, Status ) ;
            if( US = nil ) then
            begin
                exit ;
            end ;
            try
                Status := File_Lookup( US.Contents, S1I2_Request.Integer1, S1I2_Request.Integer2 ) ;
            finally
                US.Free ;
            end ;
            Write_User( Kernel, Kernel.PID, S1I2_Request.Request.Status, sizeof( Status ), Status ) ;
        finally
            Exit_System_Call( integer( S1I2_Request ), PID, MMC, 
                sizeof( TS1I2_Request ) - sizeof( SReq ) ) ;
        end ;
    end ;
UOS_FIP_Lookup_Close:
    begin
        UE := Enter_System_Call( Request, SReq, PID, MMC, 
            sizeof( Integer_Request ) - sizeof( SReq ), Address ) ;
        if( UE <> nil ) then
        begin
            Set_Last_Error( UE ) ;
            exit ;
        end ;
        try
            Integer_Request := PInteger_Request( Address ) ;

            Status := File_Lookup_Close( Integer_Request.Int ) ;
            Write_User( Kernel, Kernel.PID, Integer_Request.Request.Status, sizeof( Status ), Status ) ;
        finally
            Exit_System_Call( integer( Integer_Request ), PID, MMC, 
                sizeof( Integer_Request ) - sizeof( SReq ) ) ;
        end ;
    end ;
UOS_FIP_Lookup_Name:
    begin
        UE := Enter_System_Call( Request, SReq, PID, MMC, sizeof( Integer2_Request ) - sizeof( SReq ), 
            Address ) ;
        if( UE <> nil ) then
        begin
            Set_Last_Error( UE ) ;
            exit ;
        end ;
        try
            Integer2_Request := PInteger2_Request( Address ) ;

            Status := File_Lookup_Name( Integer2_Request.Int1, Integer2_Request.Int2 ) ;
            Write_User( Kernel, Kernel.PID, Integer2_Request.Request.Status, sizeof( Status ), Status ) ;
        finally
            Exit_System_Call( integer( Integer2_Request ), PID, MMC, 
                sizeof( Integer2_Request ) - sizeof( SReq ) ) ;
        end ;
    end ;

This code handles the three new functions in the TUOS_FIP.API method. Again, there is nothing here that we haven't covered before.

function TUOS_FiP.File_Lookup( Spec : string ; ContextAddr, ResLen : int64 ) : integer ;

var Access, Secondary : string ;
    Context : int64 ;
    Search : TSearch_Device_Context ;
    Status : int64 ;

begin
    Result := 0 ;
    if( ContextAddr = 0 ) then // No context address
    begin
        exit ;
    end ;
    Context := Get_User_Integer( Kernel, Kernel.PID, ContextAddr, Result ) ;
    if( Result <> 0 ) then
    begin
        exit ;
    end ;
    Spec := trim( Spec ) ;

    Search := TSearch_Device_Context( USC.Get_Context( Kernel.PID, Context ) ) ;
    if( Search <> nil ) then
    begin
        if( Search.Context_Type <> CT_Search ) then
        begin
            Generate_Exception( UOSErr_Invalid_Context ) ;
            exit ;
        end ;
    end ;

This function takes the file specification and the addresses of the context value and the result length. If the context address is 0, there is nothing to do and we exit. If there is an error getting the context value from the user space, we also exit. Otherwise, we trim the specification and request the context instance from the USC component. Like all other process contexts, file search contexts are managed by the TProcess class. If there is no context, that is fine. But if there is, we check to make sure it is a CT_Search context type. If it isn't, we return an exception because it means that the application passed some other context (such as a process scan context) instead of a file search context. Obviously the different kinds of contexts are incompatible, so this is considered an error.

    if( Spec <> '' ) then // A new search
    begin
        if( Search <> nil ) then // Existing search context
        begin
            USC.Delete_Context( Kernel.PID, int64( Search ) ) ;
        end ;
        Search := TSearch_Device_Context.Create( self, nil ) ;
        Parse_Filename( Spec, Search._Node, Access, Secondary, Search._Device,
            Search._Path, Search._Name, Search._Extension, Search._Version ) ;
        if( ( Search._Node <> '' ) and ( Search._Node <> Kernel.Node_Name ) ) then
        begin
            Search.Free ;
            Generate_Exception( UOSErr_Node_Not_Found ) ;
            exit ;
        end ;
        if( Search._Device = '' ) then // No device specified
        begin
            Search.Free ;
            Generate_Exception( UOSErr_Device_Not_Found ) ;
            exit ;
        end ;
        Normalize_Path( Search._Path ) ;
        if( Search._Path = '' ) then
        begin
            Search.Free ;
            Generate_Exception( UOSErr_Invalid_Path ) ;
            exit ;
        end ;
        if( pos( ';', Search._Device ) = 0 ) then // Not a device list
        begin
            if( Get_Device( Search._Device ) = nil ) then
            begin
                Search.Free ;
                Generate_Exception( UOSErr_Device_Not_Found ) ;
                exit ;
            end ;
        end ;
        USC.Add_Context( Kernel.PID, Search ) ;
        Status := Write_User_int64( Kernel, Kernel.PID, ContextAddr, int64( Search ) ) ;
        if( Status <> 0 ) then
        begin
            exit ;
        end ;
    end else

If the Lookup service is called with a file specification, it begins a new search. If it is passed a null string, it continues the previous search. Here we handle the first case. If the context already exists, we delete the old one. Then we create a new device-level search instance. We parse the passed file specification, directing the individual fields to the search instance. If no node is specified, we assume the current one, but if a node name is given and it is not the current node name, we return an error. We will handle searches on remote nodes in the future.

Next we check for a device specification. A valid device must be specified otherwise we don't know which file system to search. Then we normalize the path. We will cover the Normalize_Path function below. If that function reduces the path to zero length, it indicates an error and we exit. The device-level search instance will validate the device name, but we do a check here as well, as long as it isn't a multi-device path (indicated by the presence of a semicolon). And if the device is invalid, we exit with an error.

Now that we've verified that the search instance exists and we've done some basic validation, we add the context to the process and write the new context value to the user's context address.

    if( Search = nil ) then // No spec and no context
    begin
        exit ;
    end ;
    Search.Find_Next ;
    Write_User_int64( Kernel, Kernel.PID, ResLen, length( Search.Last_Result ) ) ;
end ; // TUOS_FiP.File_Lookup

If, however, no specification was passed in and a search context wasn't provided, we exit. A null specification assumes a previous call that created a search context. Otherwise, we drop down to the Find_Next call, whether this is the initial search or a find next operation. This method of the search context sets its Last_Result instance data to the next matching file (or null if no more matches). So we write the length of that file name to the result length address.

procedure Normalize_Path( var Path : string ) ;

var I, L : integer ;

begin
    if( copy( Path, length( Path ), 1 ) <> '\' ) then
    begin
        Path := Path + '\' ;
    end ;
    if( copy( Path, 1, 1 ) <> '\' ) then
    begin
        Path := '\' + Path ;
    end ;
    I := pos( '\**\', Path ) ;
    if( I > 0 ) then
    begin
        Path := copy( Path, 1, I + 3 ) ; // Anything after \**\ is extraneous
    end ;
    if( Path = '' ) then
    begin
        Path := '\' ;
    end ;
    I := pos( '\**^\', Path ) ;
    while( I <> 0 ) do
    begin
        if( I = 1 ) then
        begin
            Path := '' ;
            exit ;
        end ;
        if( I > 0 ) then
        begin
            L := I - 1 ;
            while( ( L > 0 ) and ( Path[ L ] <> '\' ) ) do
            begin
                dec( L ) ;
            end ;
            Path := copy( Path, 1, L ) + copy( Path, I + 5, length( Path ) ) ;
        end ;
        I := pos( '\**^\', Path ) ;
    end ;
end ;

This function normalizes a UOS file path. The primary purpose is to remove any extraneous information. First, we make sure the path begins and ends with a backslash. Next, if a subdirectories wildcard is provided, we remove any pathing information past that point. Second, we handle the parent folder construct. What we do is flatten the path so that it represents an absolute path instead of a relative one. For instance:
\a\b\**^\
would be normalized to:
\a\
However, there is a possibillty that the parent construct is used in a case where there is no parent. For instance:
\a\b\**^\**^\**^\
This would be the same as \a\**^\**^\ which is the same as \**^\, or the parent of the root directory. But the root directory has no parent, so such a path is invalid. In this case, we set the result to null and exit. Otherwise, we reduce the parent construct to simply be the parent directory in the path. We loop through until all such constructs have been reduced or we encounter an error.

type TSearch_Context = class( TContext )
                           public // Constructors and destructors
                               constructor Create( _FIP : TUOS_FIP ; Parent : TSearch_Context ) ;
                               destructor Destroy ; override ;

                           public // Instance data...
                               FIP : TUOS_FiP ;
                               _Path : string ;
                               _Name : string ;
                               _Extension : string ;
                               _Version : string ;

                               Last_Result : string ;
                               Info : TUOS_File_Info ;

                           private // Instance data...
                               Device : Devices.TDevice ;
                               Child : TSearch_Context ;
                               FS : TUOS_File_System ;
                               FS_Context : pointer ;

                           public // API...
                               procedure Find_Next ; virtual ;
                       end ;

     TSearch_Directory_Context = class( TSearch_Context )
                                     public // Constructors and destructors
                                         constructor Create( _FIP : TUOS_FIP ;
                                             Parent : TSearch_Context ;
                                             Parent_Path : string ) ;

                                     public // Instance data...
                                         Path_Prefix : string ; // Should always end with "\"

                                     private // Instance data...
                                         This_Directory : string ;
                                         Wildcard : boolean ;

                                     public // API...
                                         procedure Find_Next ; override ;
                                 end ;

     TSearch_Subdirectories_Context = class( TSearch_Context )
                                          private // Instance data...
                                              This_Directory : string ;

                                          public // API...
                                              procedure Find_Next ; override ;
                                      end ;

     TSearch_Device_Context = class( TSearch_Context )
                                  public // Instance data...
                                      _Node : string ;
                                      _Device : string ;

                                  private
                                      This_Device : string ;

                                  public // API...
                                      procedure Find_Next ; override ;
                              end ;

These are the definitions for the four search classes mentioned above. TSearch_Context is the base class and the others descend from it.

procedure TSearch_Device_Context.Find_Next ;

var I : integer ;
     Path, S : string ;
     
begin
    while( true ) do
    begin
        Last_Result := '' ;
        if( Child <> nil ) then
        begin
            Child.Find_Next ;
            Last_Result := Child.Last_Result ;
            if( length( Last_Result ) > 0 ) then
            begin
                Last_Result := This_Device + Last_Result ;
                exit ;
            end ;
            Child.Free ;
            Child := nil ;
        end ; // if( Child <> nil )

        // Get next device...
        I := pos( ';', _Device ) ;
        if( I = 0 ) then
        begin
            This_Device := _Device ;
            _Device := '' ;
        end else
        begin
            This_Device := copy( _Device, 1, I - 1 ) ;
            _Device := copy( _Device, I + 1, length( _Device ) ) ;
        end ;
        if( This_Device = '' ) then // No more devices in path
        begin
            exit ;
        end ;
        S := FIP.Resolve_Device( This_Device ) ;
        I := pos( ':', S ) ;
        Path := copy( S, I + 1, length( S ) ) ;
        S := copy( S, 1, I ) ;
        Device := Devices.TDevice( FIP.Get_Device( S ) ) ;
        if( ( Device <> nil ) and ( Device.FS <> nil ) and Device.Mounted ) then
        begin
            FS := Device.FS ;
            if( Path <> '' ) then
            begin
                Normalize_Path( Path ) ;
                setlength( Path, length( Path ) - 1 ) ; // Trim trailing \
            end ;
            _Path := Path + _Path ; // Add extra pathing
            if( copy( _Path, 1, 4 ) = '\**\' ) then
            begin
                Child := TSearch_Subdirectories_Context.Create( FIP, self ) ;
                Child._Path := '\' ;
            end else
            begin
                Child := TSearch_Directory_Context.Create( FIP, self, '\' ) ;
            end ;
            _Path := copy( _Path, length( Path ) + 1, length( _Path ) ) ; // Remove extra pathing
            Child.Find_Next ;
            Last_Result := Child.Last_Result ;
            if( length( Last_Result ) > 0 ) then
            begin
                Last_Result := This_Device + Last_Result ;
                exit ;
            end ;
            Child.Free ;
            Child := nil ;
        end ;
    end ; // while( true )
end ; // TSearch_Device_Context.Find_Next

The purpose of the TSearch_Device_Context class is to iterate through the devices in a device list. We loop until we have a resolution one way or another, always setting the Last_Result to null first. If we already have a child (not the first lookup for this device), we call that child to find the next match. If found, we return that result and exit. Otherwise, there are no more matches for this device. So we free the child and set the Child value to nil. If the child is nil, we look for the next device in the list. We extract it, using the semicolon delimiter.

Then we check for the validity of the device. If it is valid, has a file system, and is mounted, we create a directory-level iterator child. If the first part of the path is a subdirectories wildcard, we construct a TSearch_Subdirectories_Context instance. Otherwise we construct a TSearch_Directory_Context instance. Then we have the child find the next (first) match. On the other hand, if the child has no matches, we free it and loop back to find the next device in the list. Note that no errors are returned for invalid devices, they are simply treated as having no matches. We will discuss the Resolve_Device method in a bit.

Because the resolved device name may also include a path itself, we prepend our own _Path with that path so that our children pick it up, and then we get strip if back off of _Path in preparation for the next device in the list. If we didn't remove the extra path then the lookup for the next device would include that extra pathing.

constructor TSearch_Directory_Context.Create( _FIP : TUOS_FIP ;
    Parent : TSearch_Context ; Parent_Path : string ) ;

var I : integer ;

begin
    inherited Create( FIP, Parent ) ;

    Path_Prefix := Parent_Path ;
    _Path := copy( _Path, length( Path_Prefix ) + 1, length( _Path ) ) ;
    I := pos( '\', _Path ) ;
    This_Directory := copy( _Path, 1, I - 1 ) ;
    _Path := copy( _Path, I + 1, length( _Path ) ) ;
    FS := Device.FS ;
    Wildcard := ( ( pos( '?', This_Directory ) + pos( '*', This_Directory ) ) > 0 ) ;
end ;

The constructor for the directory-level search object parses out the first directory in the path that follows the parent path passed in. What this is doing is preparing the instance to iterate over the portion of the path assigned to it - which will be a single directory in the path. All higher levels of the path are handled by parent directory search context instances and all lower levels of the path are handled by child directory search context instances. Thus, for the path "\a\*\b\", we would have an instance to handle \a\, another to handle \a\*\, and another to handle "\a\*\b\". We also set a flag if our particular level has a wildcard in it.

procedure TSearch_Directory_Context.Find_Next ;

begin
    while( true ) do
    begin
        if( Child = nil ) then // First time...
        begin
            if( Wildcard ) then
            begin
                if( FS_Context = nil ) then // First lookup
                begin
                    // Find first matching directory
                    Last_Result := FS.Lookup( PChar( Path_Prefix + This_Directory ), FS_Context ) ;
                end else
                begin
                    Last_Result := FS.Lookup( '', FS_Context ) ; // Find next matching directory
                end ;
                if( Last_Result = '' ) then // No match
                begin
                    exit ;
                end ;
                This_Directory := Last_Result ;
            end ;
            if( This_Directory = '**' ) then
            begin
                Child := TSearch_Subdirectories_Context.Create( FIP, self ) ;
            end else
            if( length( _Path ) = 0 ) then // We are the last directory in the path
            begin
                Child := TSearch_Context.Create( FIP, self ) ;
                if( length( This_Directory ) > 0 ) then
                begin
                    Child._Path := Path_Prefix + This_Directory + '\' ;
                end else
                begin
                    Child._Path := Path_Prefix ;
                    if( copy( Child._Path, length( Child._Path ), 1 ) <> '\' ) then
                    begin
                        Child._Path := Child._Path + '\' ;
                    end ;
                end ;
            end else
            begin
                Child := TSearch_Directory_Context.Create( FIP, self, Path_Prefix + This_Directory ) ;
            end ;
        end ; // if( Child = nil )

As before, we loop until we have a result, even if that result is no matches. If we have no child object, this is our first time and we want to construct our child. If we have a wildcard and this is our first lookup, we do a new lookup within the parent path (This_Directory contains our path specification which has a wildcard). If this isn't our first lookup, we do a lookup passing a null string. If there was no result, we exit.

Otherwise, if our path is the subdirectories construct (**), we create a TSearch_Subdirectories_Context instance. If not, then if the remainder of the path past us (stored in _Path) is null, we are the lowest level of the path and we construct a search context to iterate through the files in this directory. But if there is more of the path beyond us, we construct a directory iterator.

        Child.Find_Next ;
        Last_Result := Child.Last_Result ;
        if( length( Last_Result ) = 0 ) then
        begin
            Child.Free ;
            Child := nil ;
            if( not Wildcard ) then
            begin
                exit ; // Nothing more to do
            end ;
        end else
        begin
            exit ; // Found an match
        end ;
    end ; // while( true )
end ; // TSearch_Directory_Context.Find_Next

Once we get here, we have a child search instance so we ask it to find the next match. If there is none, we free the child. If we are not a wildcard, we exit because we are done. But if we are a wildcard, we loop back to find the next matching directory.

constructor TSearch_Context.Create( _FIP : TUOS_FIP ; Parent : TSearch_Context ) ;

begin
    inherited Create ;

    Context_Type := CT_Search ;
    FIP := _FIP ;
    if( Parent <> nil ) then
    begin
        _Path := Parent._Path ;
        _Name := Parent._Name ;
        _Extension := Parent._Extension ;
        _Version := Parent._Version ;
        Device := Parent.Device ;
        FS := Parent.FS ;
    end ;
end ;


destructor TSearch_Context.Destroy ;

begin
    FreeAndNil( Child ) ;

    inherited Destroy ;
end ;

The constructor for TSearch_Context simply copies data from the parent and initializes a couple values. All that is needed for the destructor is to free any child.

procedure TSearch_Context.Find_Next ;

var S : string ;

begin
    // Grab next file from file system...
    if( FS <> nil ) then
    begin
        if( FS_Context = nil ) then
        begin
            S := FS.Lookup( PChar( _Path + _Name + _Extension + _Version ), FS_Context ) ;
        end else
        begin
            S := FS.Lookup( '', FS_Context ) ;
        end ;
        if( length( S ) > 0 ) then
        begin
            Last_Result := _Path + S ;
            Info := FS.Get_File_Info( PChar( Last_Result ), 0 ) ;
        end else
        begin
            Last_Result := '' ;
        end ;

        // No more matches...
    end ; // if( FS <> nil )
end ; // TSearch_Context.Find_Next

This class is used to iterate through all matching files within a directory. If this is our first lookup (FS_Context is nil), we ask the file system to do an initial lookup, otherwise we ask for the next lookup. If we get a result, we also load the file information for the file, which can be used by one or more of our parents.

procedure TSearch_Subdirectories_Context.Find_Next ;

begin
    while( true ) do
    begin
        if( Child = nil ) then // First time...
        begin
            if( FS_Context = nil ) then // First lookup
            begin
                // Find first matching directory
                Last_Result := FS.Lookup( PChar( _Path + '*' ), FS_Context ) ;
            end else
            begin
                Last_Result := FS.Lookup( '', FS_Context ) ; // Find next matching directory
            end ;
            if( Last_Result = '' ) then // No match
            begin
                exit ;
            end ;
            This_Directory := Last_Result ;
            Info := FS.Get_File_Info( PChar( _Path + Last_Result ), 0 ) ;
            if( ( Info.Flags and FAF_DIRECTORY ) <> 0 ) then
            begin
                Child := TSearch_Subdirectories_Context.Create( FIP, self ) ;
                Child._Path := Child._Path + Last_Result + '\' ;
            end ;
            if( WC_Match( _Name + _Extension + _Version, Last_Result, TT_UTF8 ) ) then
            begin
                Last_Result := _Path + Last_Result ;
                exit ; // Return directory this time
            end ;
        end ; // if( Child = nil )
        Child.Find_Next ;
        Last_Result := Child.Last_Result ;
        if( length( Last_Result ) = 0 ) then
        begin
            Child.Free ;
            Child := nil ;
        end else
        begin
            exit ; // Found an match
        end ;
    end ; // while( true )
end ; // TSearch_Subdirectories_Context.Find_Next

TSearch_Subdirectories_Context handles the subdirectories wildcard. It is similar to the code for the TSearch_Directory_Context class. Because we know we are searching all subdirectories, our first file system lookup will be for our parent path plus a wildcard. If there are no matches, we are done and exit. If we find a directory, we create another instance of ourselves as our child, and set the child's path to include the found directory. If the file we found matches the filename specification, we return it as the first match and exit. The next time we enter this code, since Child is set, we will ask it for its first match. If the found directory name doesn't match the file specification we're looking for, we don't exit and instead drop through to ask the child for its next (in this case, first) match. If the child has no matches, we free it and loop back to look up the next directory to search. Note that if we find a matching non-directory file, Child will still be nil, when we are called again so we will look for the next file in the current path.

function TUOS_FIP.Resolve_Device( Device : string ) : string ;

var I : integer ;

begin
    I := pos( ':', Device ) ;
    if( I = 0 ) then
    begin
        Result := Device ;
        exit ;
    end ;
    Result := Resolve_Symbol( Kernel.PID, PChar( copy( Device, 1, I ) ) ) ;
    Result := Result + copy( Device, I + 1, length( Device ) ) ;
end ;

This function resolves a device reference. A logical device can refer to one or more devices delimited by colons. But it can also include pathing information as well. This function extracts the device portion, translates the symbol, and appends the path back onto the result.

function TUOS_FiP.File_Lookup_Name( ContextAddr, ResAddr : int64 ) : int64 ;

var Search : TSearch_Context ;
    Status : longint ;

begin
    Result := 0 ;
    if( ContextAddr = 0 ) then
    begin
        Generate_Exception( UOSErr_Invalid_Context ) ;
        exit ;
    end ;
    ContextAddr := Get_User_Integer( Kernel, Kernel.PID, ContextAddr, Status ) ;
    if( Status <> 0 ) then
    begin
        Result := Status ;
        exit ;
    end ;
    Search := TSearch_Context( USC.Get_Context( Kernel.PID, ContextAddr ) ) ;
    if( ( Search = nil ) or ( Search.Context_Type <> CT_Search ) ) then
    begin
        Generate_Exception( UOSErr_Invalid_Context ) ;
        exit ;
    end ;
    Write_User( Kernel, Kernel.PID, ResAddr, length( Search.Last_Result ), 
        PChar( Search.Last_Result )[ 0 ] )
end ;

This function gets the context from the passed address, exiting if the address is 0 or if we can't read the value from the user memory. We then verify that the context already exists and is the correct type. If not, we generate an error. Otherwise, we copy the context's last result to the destination address.

function TUOS_FiP.File_Lookup_Close( ContextAddr : int64 ) : int64 ;

var Search : TSearch_Context ;
    Status : integer ;

begin
    Result := 0 ;
    if( ContextAddr = 0 ) then
    begin
        Generate_Exception( UOSErr_Invalid_Context ) ;
        exit ;
    end ;
    ContextAddr := Get_User_Integer( Kernel, Kernel.PID, ContextAddr, Status ) ;
    Search := TSearch_Context( USC.Get_Context( Kernel.PID, ContextAddr ) ) ;
    if( ( Search = nil ) or ( Search.Context_Type <> CT_Search ) ) then
    begin
        Generate_Exception( UOSErr_Invalid_Context ) ;
        exit ;
    end ;
    USC.Delete_Context( Kernel.PID, int64( Search ) ) ;
end ;

This function closes a search context. First we verify that the context exists and is of the correct type. If not, we generate an error. Otherwise, we tell the USC to delete the context.

In the next article, we will look at the next lexical function.