SYS_DEVICE_SCAN

In the previous article, we examined the F$DEVICE lexical function. It is the UCL interface to the SYS_DEVICE_SCAN system call. There are many similarities between SYS_DEVICE_SCAN and SYS_PROCESS_SCAN. Thankfully, SYS_DEVICE_SCAN is simpler. Like SYS_PROCESS_SCAN, a process can have multiple DEVICE_SCANs going on simultaneously. Thus, we will need to add another list of contexts - or, rather, we will have multiple types of contexts in the process context list. In fact, in the future, we will introduce more types of contexts.

function SYS_DEVICE_SCAN( ReturnA, LengthA, Devnam, Itemlist, Context : int64 ) : int64 ;

var IOSB : TIOSB ;
    SRB : PSRB ;
    Status : int64 ;
    SysRequest : TS1I4_Request ;

begin
    SRB := PSRB( pointer( Devnam ) ) ;
    fillchar( SysRequest, sizeof( SysRequest ), 0 ) ;
    Status := 0 ;
    SysRequest.Request.Subsystem :=  UOS_Subsystem_USC ;
    SysRequest.Request.Request := UOS_USC_Device_Scan ;
    SysRequest.Request.Length := sizeof( SysRequest ) - sizeof( Sysrequest.Request ) ;
    SysRequest.Request.Status := integer( @Status ) ;
    SysRequest.SRB.Buffer := SRB.Buffer ;
    SysRequest.SRB.Length := SRB.Length ;
    SysRequest.Integer1 := ReturnA ;
    SysRequest.Integer2 := LengthA ;
    SysRequest.Integer3 := ItemList ;
    SysRequest.Integer4 := Context ;

    Call_To_Ring0( integer( @SysRequest ) ) ;

    Result := Status ;
end ;

As with our other system calls, this function constructs a system request structure and passes it to the executive.

    UOS_USC_Device_Scan:
        begin
            UE := Enter_System_Call( Request, SReq, PID, MMC, 
                sizeof( TS1I4_Request ) - sizeof( SReq ), Address ) ;
            if( UE <> nil ) then
            begin
                Set_Last_Error( UE ) ;
                exit ;
            end ;
            try
                S1I4_Request := PS1I4_Request( Address ) ;
                Device_Scan_Context( PID, Get_User_String( Kernel, PID, S1I4_Request.SRB, Status ),
                    S1I4_Request.Integer1, S1I4_Request.Integer2, S1I4_Request.Integer3, 
                    S1I4_Request.Integer4, IOSB ) ;
                Write_User( Kernel, PID, S1I4_Request.Request.Status, 
                    sizeof( IOSB.r_io_64.w_status ), IOSB.r_io_64.w_status ) ;
            finally
                Exit_System_Call( Request, PID, MMC, sizeof( TS1I4_Request ) - sizeof( SReq ) ) ;
            end ;
        end ;

We add a new case to the TUSC.API method. This does the standard system call handling and passes data to the Device_Scan_Context method.

type TContext_Type = ( CT_Abstract, CT_Process, CT_Device ) ;

     TContext = class
                    public // Instance data...
                        Context_Type : TContext_Type ;
                end ;

     TProcess_Scan_Context = class( TContext )
                                public // Constructors and destructors...
                                     constructor Create ;
                                     destructor Destroy ; override ;

                                 public // API...
                                     Filters : TList ; // List of filters
                                     Last_PID : TPID ; // Context

                                     function Next_PID : TPID ;
                             end ; // TProcess_Scan_Context

Since we need multiple types of contexts and a way to distinguish them, we define TContext, which will serve as a base class for the various types of contexts. It contains a context type value that we can use to validate that the correct type of context is being used. Then we descend TProcess_Scan_Context from that base class.


    Context_Type := CT_Process ;

This line is added to the TProcess_Scan_Context constructor so that we can tell this context from other types.

     TDevice_Scan_Context = class( TContext )
                                public // Constructors and destructors...
                                    constructor Create( K : TUOS_Kernel ; P : TPID ) ;
                                    destructor Destroy ; override ;

                                private // Instance data..
                                    _Device_Name : string ;
                                    RU : TUnicode_String ;

                                protected // Property handlers...
                                    procedure Set_DevName( Value : string ) ;
                                    procedure Set_ItemList( Value : int64 ) ;

                                public // API...
                                    Filters : TList ; // List of filters
                                    _Next_Device : cardinal ; // Context
                                    Kernel : TUOS_Kernel ;
                                    PID : TPID ;

                                    procedure Clear ;
                                    function Next_Device : cardinal ;

                                public // Properties...
                                    property DevName : string
                                        read _Device_Name
                                        write Set_DevName ;
                                    property ItemList : int64
                                        write Set_ItemList ;
                            end ; // TProcess_Scan_Context

We define another TContext descendent called TDevice_Scan_Context.

// TDevice_Scan_Context methods...

// Constructors and destructors...

constructor TDevice_Scan_Context.Create( K : TUOS_Kernel ; P : TPID ) ;

begin
    inherited Create ;

    Context_Type := CT_Device ;
    Filters := TList.Create ;
    Kernel := K ;
    PID := P ;
end ;


destructor TDevice_Scan_Context.Destroy ;

begin
    Clear ;
    Filters.Free ;
    if( RU <> nil ) then
    begin
        RU.Free ;
    end ;

    inherited Destroy ;
end ;

The constructors and destructors create and free the filters, respectively. The constructor also sets the context type and stores the PID and the kernel instance.

// Property handlers...

procedure TDevice_Scan_Context.Set_DevName( Value : string ) ;

begin
    Value := trim( Value ) ;
    if( Value <> _Device_Name ) then
    begin
        _Next_Device := 0 ;
        _Device_Name := Value ;
        if( RU <> nil ) then
        begin
            RU.Free ;
        end ;
        if( _Device_Name <> '' ) then // If a device name specification given
        begin
            RU := TUnicode_String.Create ;
            RU.Assign_From_String( _Device_Name, ST_UTF8 ) ;
            RU.Lowercase ;
        end ;
    end ;
end ;

If the device name is changed, we reset the _Next_Device. If this instance data is 0, we consider ourselves ready to return the first device matching the criteria.

// API...

procedure TDevice_Scan_Context.Clear ;

var I : integer ;

begin
    for I := 0 to Filters.Count - 1 do
    begin
        TDevice_Filter( Filters[ I ] ).Free ;
        Filters[ I ] := nil ;
    end ;
    Filters.Clear ;
end ;

The Clear method destroys the filters and clears the list.

We'll look at the last two methods of the class later in the article.

procedure TUSC.Device_Scan_Context( PID : TPID ; Devname : TUOS_String ;
    Return, RetLen, ItemLst, ContextAdr : int64 ; var IOSB : TIOSB ) ;

var Context : int64 ;
    Device : TFIP_Device ;
    Device_Context : TDevice_Scan_Context ;
    Index : cardinal ;
    Process : TProcess ;
    S : string ;
    SRB : TSRB ;
    Status : longint ;

begin
    // Setup...
    fillchar( IOSB, sizeof( IOSB ), 0 ) ;
    if( ContextAdr = 0 ) then // Invalid address
    begin
        Generate_Exception( UOSErr_Bad_Parameter ) ;
        exit ;
    end ;
    Process := Get_Process( PID ) ;

    // Get context value...
    Context := Get_User_Integer( Kernel, PID, ContextAdr, Status ) ;
    if( Status = UE_Error ) then
    begin
        IOSB.r_io_64.w_status := Status ;
        if( MMC.Last_Error = nil ) then
        begin
            Generate_Exception( UOSErr_Memory_Address_Error ) ;
        end ;
        exit ;
    end ;

This method handles the device scan system call. A context address must be provided or we return with an error. Then we get the context value from that address and return if the operation caused an error.

    // Create new context, if needed...
    if( Context = 0 ) then
    begin
        Context := int64( TDevice_Scan_Context.Create( Kernel, PID ) ) ;
        Status := Write_User_int64( Kernel, PID, ContextAdr, Context ) ;
        if( Status = UE_Error ) then
        begin
            IOSB.r_io_64.w_status := Status ;
            if( MMC.Last_Error = nil ) then
            begin
                Generate_Exception( UOSErr_Memory_Address_Error ) ;
            end ;
            exit ;
        end ;
        Process.Add_Context( TContext( Context ) ) ;
    end ;

If the context value is zero, we need to create a new one. Se create the context and write the address to the context address, and add the context to the process. If an error occurs, we exit.

    // Validate context...
    if( Process.Get_Context( Context ) = nil ) then
    begin
        IOSB.r_io_64.w_status := UE_Error ;
        Generate_Exception( UOSErr_Invalid_Context ) ;
        exit ;
    end ;
    Device_Context := TDevice_Scan_Context( pointer( Context ) ) ;
    if( Device_Context.Context_Type <> CT_Device ) then
    begin
        IOSB.r_io_64.w_status := UE_Error ;
        Generate_Exception( UOSErr_Invalid_Context ) ;
        exit ;
    end ;

Next we verify that the context passed to us is a context for this process. If not, we exit with an error. Otherwise, we check the context to make sure it is a device context. If not, we exit with an error.

    S := Devname.Contents ;
    if( copy( S, length( S ), 1 ) = ':' ) then
    begin
        setlength( S, length( S ) - 1 ) ; // Strip colon
    end ;
    Device_Context.DevName := S ;
    Device_Context.ItemList := ItemLst ;

We copy the context's device name to S. If the device name ends in a colon, we remove it (since a terminal colon is implied at the end of every device name). Then we update the context with the device name and the passed item list. If the name differs from what the context already has, it resets the context, as we described above. We'll look at the handling of the item list in a bit.

    Index := Device_Context.Next_Device ;
    if( Index = 0 ) then // No (more) matches
    begin
        IOSB.r_io_64.w_status := UE_Error ;
        Generate_Exception( UOSErr_Device_Not_Found ) ;
        exit ;
    end ;

Now we ask the context for the next device matching it's criteria. The return value is the File Processor device index plus 1. Thus, 0 indicates a failure (no more matching devices).

    Device := FIP.Get_Device_By_Index( Index - 1 ) ;
    S := FIP.Device_Name( Device ) ;
    Status := Write_User_int64( Kernel, PID, RetLen, length( S ) ) ;
    if( Status = UE_Error ) then
    begin
        IOSB.r_io_64.w_status := Status ;
        if( MMC.Last_Error = nil ) then
        begin
            Generate_Exception( UOSErr_Memory_Address_Error ) ;
        end ;
        exit ;
    end ;

Next we get the device from the File Processor, passing the index (minus 1). Then we get the device's name. We write the length of the device name to the length return address. If there was an error writing the data, we exit.

    SRB.Buffer := Return ;
    SRB.Length := length( S ) ;
    Status := Set_User_String( Kernel, PID, SRB, S ) ;
    if( Status = UE_Error ) then
    begin
        IOSB.r_io_64.w_status := Status ;
        if( MMC.Last_Error = nil ) then
        begin
            Generate_Exception( UOSErr_Memory_Address_Error ) ;
        end ;
    end ;
end ; // TUSC.Device_Scan_Context

Finally, we construct a TSRB structure for the device name string and use Set_User_String to write the value back to the user's receiving buffer.

     TDevice_Filter = class
                          public // Instance data...
                              Criteria : longint ;
                              ValueI : int64 ;
                      end ;

This class is used for filters for device scans.

procedure TDevice_Scan_Context.Set_ItemList( Value : int64 ) ;

var Descriptor : TDVI_Descriptor ;
    Filter, OFilter : TDevice_Filter ;
    I : integer ;
    New_Filters : TList ;
    Status : longint ;

begin
    if( Value = 0 ) then
    begin
        exit ;
    end ;

    New_Filters := TList.Create ;
    Get_User_Data( Kernel, PID, Value, sizeof( Descriptor ), Descriptor, Status ) ;
    while( ( Descriptor.Item_Code <> 0 ) or ( Descriptor.Buffer_Length <> 0 ) ) do
    begin
        Filter := TDevice_Filter.Create ;
        Filter.Criteria := Descriptor.Item_Code ;
        Filter.ValueI := Get_User_Integer( Kernel, PID, Descriptor.Buffer_Address, Status ) ;
        New_Filters.Add( Filter ) ;
        Value := Value + sizeof( Descriptor ) ;
        Get_User_Data( Kernel, PID, Value, sizeof( Descriptor ), Descriptor, Status ) ;
    end ;

When the item list is set for a device scan context, we iterate through the descriptors that start at the item list address until we hit the terminating descriptor (one with the item code and buffer length of 0). For each descriptor, we create a filter and set its values from the descriptor.

    // See if new filters changed from old filters...
    if( New_Filters.Count <> Filters.Count ) then
    begin
        Clear ;
        Filters.Free ;
        Filters := New_Filters ;
        New_Filters := nil ;
        _Next_Device := 0 ;
    end ;
    if( New_Filters <> nil ) then
    begin
        for I := 0 to Filters.Count - 1 do
        begin
            OFilter := TDevice_Filter( Filters[ I ] ) ;
            Filter := TDevice_Filter( New_Filters[ I ] ) ;
            if( ( Filter.Criteria <> OFilter.Criteria ) or ( Filter.ValueI <> OFilter.ValueI ) ) then
            begin // Change from previous criteria
                Clear ;
                Filters.Free ;
                Filters := New_Filters ;
                New_Filters := nil ;
                _Next_Device := 0 ;
                exit ;
            end ;
        end ; // for I := 0 to Filters.Count - 1
        for I := 0 to New_Filters.Count - 1 do
        begin
            TDevice_Filter( New_Filters[ I ] ).Free ;
            New_Filters[ I ] := nil ;
        end ;
        New_Filters.Free ;
    end ;
end ; // TDevice_Scan_Context.Set_ItemList

If the existing filter count doesn't match the newly created filter list, we clear the _Next_Device, clear the existing filters, assign the newly created filters to Filters, and set New_Filters to nil. If we haven't done that, we compare the old filters with the new filters. Any change that is found results in us clearing the old filters, using the new filters and setting _Next_Device to 0. If the current and new filter lists match, we simply delete the new filters.

function TDevice_Scan_Context.Next_Device : cardinal ;

var Device : TFIP_Device ;
    Filter : TDevice_Filter ;
    I : integer ;
    Info : TDevice_Info ;
    LU : TUnicode_String ;
    Match : boolean ;
    Name : string ;
    VMS_Class : integer ;

begin
    // Setup...
    Result := 0 ; // Assume none found

    // Scan devices...
    while( true ) do // Until we find a match or run out of devices
    begin
        Device := Kernel.FIP.Get_Device_By_Index( _Next_Device ) ;
        if( Device = nil ) then // Ran out of devices
        begin
            exit ;
        end ;

The Next_Device method returns the next device index matching the criterial. We default to 0 to indicate a failure. Then we loop until we find the matching device, or until we've run out of devices - which is indicated by the Get_Device_By_Index method returning nil.

        Name := Kernel.FIP.Device_Name( Device ) ;
        Info := Device.Get_Updated_Info ;
        if( _Device_Name <> '' ) then // If a device name specification given
        begin
            LU := TUnicode_String.Create ;
            LU.Assign_From_String( Name, ST_UTF8 ) ;
            LU.Lowercase ;
            if( Compare( LU, RU, True ) <> 0 ) then // Not a match
            begin
                inc( _Next_Device ) ;
                LU.Free ;
                continue ;
            end ;
            LU.Free ;
        end ;

We get the device's name and associated device information. If _Device_Name was specificed for this context, we convert the name of the current device to lowercase unicode and then compare the two names. If there isn't a match, then this device doesn't match our criteria. So we free the unicode string, increment the device index and loop to the next device.

        Match := True ; // Assume a match
        for I := 0 to Filters.Count - 1 do
        begin
            Filter := TDevice_Filter( Filters[ I ] ) ;
            if( Filter.Criteria = DVS_DEVCLASS ) then // VMS device class
            begin
                if( Filter.ValueI <> DC_ANY ) then
                begin
                    if( copy( Name, 1, 4 ) = 'DISK' ) then
                    begin
                        VMS_Class := DC_Disk ;
                    end else
                    if( copy( Name, 1, 4 ) = 'TERM' ) then
                    begin
                        VMS_Class := DC_Term ;
                        if( ( Info.Flags and DFM_Write_Only ) <> 0 ) then
                        begin
                            VMS_Class := DC_LP ; // Write-only terminal is a printer
                        end ;
                    end else
                    begin
                        VMS_Class := DC_Misc ;
                    end ;
                    if( VMS_Class <> Filter.ValueI ) then
                    begin
                        Match := False ;
                        break ;
                    end ;
                end ;
            end ; // if( Filter.Criteria = DVS_DEVCLASS )
        end ; // for I := 0 to Filters.Count - 1

Now we loop through the filters only handling those of criteria DVS_DEVCLASS. It may seem like a lot of work for only one criteria, but in a future article, we will add new ones. First we set the Match flag to true, then we loop through the filters. Because we can tell the VMS device class from the prefix of the UOS device name, we set the VMS Class appropriately and then compare it to the filter class. If there is a mismatch, we clear the Match flag and exit the loop.

        inc( _Next_Device ) ;
        if( Match ) then
        begin
            Result := _Next_Device ;
            break ;
        end ;
    end ; // while( true )
end ; // TDevice_Scan_Context.Next_Device

We increment the device index and exit the loop if we found a match - or, more accurately, didn't have a mismatch.

Now let's look at the two new FIP methods...

function TUOS_FiP.Get_Device_By_Index( Index : cardinal ) : TFIP_Device ;

begin
    Result := nil ;
    if( ( Index >= 0 ) and ( Index < _Devices.Count ) ) then
    begin
        Result := _Devices.Get_Device( Index ) ;
    end ;
end ;

This method returns the device instance for the passed index. If the index is out of range, we return nil.

function TUOS_FIP.Device_Name( Device : TFIP_Device ) : PAnsiChar ;

var Dev : TDevice ;

begin
    Dev := TDevice( Device ) ;
    if( ( Dev.Index = -1 ) and ( Dev.Info.Controller = 0 ) and ( Dev.Info.Device_Unit = 0 ) ) then
    begin
        // Device controller 0 is always a HAL device, so if marked as index = -1, this is the null device
        Device_Name_Temp := 'NULL' ;
        Result := PAnsiChar( Device_Name_Temp ) ;
        exit ;
    end ;
    Device_Name_Temp := chr( 65 + Dev.Info.Controller ) + inttostr( Dev.Info.Device_Unit ) ;
    case ( Dev.Info.Flags and DF_Class_Mask ) of
        DFC_Stream : Device_Name_Temp := 'TERM' + Device_Name_Temp ;
        DFC_Store : Device_Name_Temp := 'DISK' + Device_Name_Temp ;
    end ;
    Result := PAnsiChar( Device_Name_Temp ) ;
end ;

This method returns a name for a device. This is the same logic we covered many articles ago in the Reload_Devices method. In fact, we simply moved that code here and call it from there.

In the next article, we'll continue examining lexical functions.