PROCESS_SCAN, Part 2

In the previous article, we discussed the TFilter and TContext classes. In this article, we will look at the PROCESS_SCAN system call which makes use of those classes.

procedure SYS_PROCESS_SCAN( pidctx, itmlst : int64 ) ;

var Status : byte ;
    SysRequest : TInteger2_Request ;

begin
    fillchar( SysRequest, sizeof( SysRequest ), 0 ) ;
    SysRequest.Request.Subsystem :=  UOS_Subsystem_USC ;
    SysRequest.Request.Request := UOS_USC_Process_Scan ;
    SysRequest.Request.Length := sizeof( SysRequest ) - sizeof( TSystem_Request ) ;
    SysRequest.Request.Status := integer( @Status ) ;
    SysRequest.Int1 := pidctx ;
    SysRequest.Int2 := ItmLst ;

    Call_To_Ring0( integer( @SysRequest ) ) ;
end ;

This is the interface function in the Sys unit. Process_Scan takes the following parameters:

Parameter	Description
pidctx	The address where to write the context value. If the value at this address is an existing context, that context is deleted and a new one is created.
itmlst	A list of filters for which to create a context. Described later in this article.

        UOS_USC_Process_Scan:
            begin
                UE := Enter_System_Call( Request, SReq, PID, MMC, 
                    sizeof( TInteger2_Request ) - sizeof( SReq ), Address ) ;
                if( UE <> nil ) then
                begin
                    Set_Last_Error( UE ) ;
                    exit ;
                end ;
                try
                    I2_Request := PInteger2_Request( Address ) ;
                    Process_Scan_Context( PID, I2_Request.Int1, I2_Request.Int2, IOSB ) ;
                finally
                    Exit_System_Call( Request, PID, MMC, sizeof( TItem_Request ) - sizeof( SReq ) ) ;
                end ;
            end ;

The USC's API method is updated to handle the Process_Scan system call. Nothing new to comment on here.

procedure TUSC.Process_Scan_Context( PID : TPID ; ContextAdr, Itemlist : int64 ;
    var IOSB : TIOSB ) ;

var Address, Base : int64 ;
    Context : int64 ;
    Filter : TFilter ;
    Item_Code : int64 ;
    Offset : int64 ;
    Process : TProcess ;
    Process_Context : TContext ;
    Reference_Descriptor : PPSCAN_Reference_Descriptor ;
    Value_Descriptor : PPSCAN_Value_Descriptor ;
    S : string ;
    US : TUOS_String ;
    Size, Status : longint ;
    SRB : TSRB ;

begin
    // Setup...
    fillchar( IOSB, sizeof( IOSB ), 0 ) ;
    if( ( ContextAdr = 0 ) or ( ItemList = 0 ) ) then // Invalid address
    begin
        Generate_Exception( UOSErr_Bad_Parameter ) ;
        exit ;
    end ;

    // 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 ;

The Process_Scan_Context method clears the IOSB and validates that the context address and item list address are non-zero. Then it gets the context itself from the user memory. Obviously we exit if there is a problem.

    // If context exists, delete it...
    Process := Get_Process( PID ) ;
    Process.Delete_Context( Context ) ;

    // Create process context
    Process_Context := TContext.Create ;

If the context already exists, we delete it. In either case, we create a new context.

    // Process items...
    while( true ) do // Until end of item list...
    begin
        Offset := MMC.Lock_Pages( PID, ItemList, Sizeof( TJPI_Value_Descriptor ) ) ;
        try
            Base := MMC.Map_Pages( PID, 0, ItemList, Sizeof( TJPI_Value_Descriptor ), MAM_Read or MAM_Lock ) ;
            if( Base = 0 ) then // Couldn't map memory
            begin
                if( MMC.Last_Error = nil ) then
                begin
                    Create_Error( UOSErr_Memory_Address_Error ) ;
                end ;
                IOSB.r_io_64.w_status := UE_Error ;
                exit ;
            end ;
            Address := Base + Offset ;
            Value_Descriptor := PPSCAN_Value_Descriptor( Address ) ;
            Size := sizeof( TPSCAN_Value_Descriptor ) ;
            if( 
                ( Value_Descriptor.Code = 0 ) 
                and 
                ( Value_Descriptor.MBO = 0 ) 
                and ( Value_Descriptor.MBMO = 0 )
            ) then
            begin
                break ; // Terminator encountered
            end ;
            if( ( Value_Descriptor.MBMO <> $FFFFFFFF ) or ( Value_Descriptor.MBO <> 1 ) ) then 
            begin
                // Improper descriptor
                Generate_Exception( UOSErr_Bad_Parameter ) ;
                IOSB.r_io_64.w_status := UE_Error ;
                MMC.UnMap_Pages( 0, Address, Size ) ;
                Process_Context.Free ;
                exit ;
            end ;

Now we loop through all of the descriptors passed in the item list. We map the next descriptor and get its size. If the descriptor's code, MBO, or MBMO fields are zero, it is the end of the list and we exit.

We need to take a moment to review the Process_Scan descriptors. There are two types: value descriptors and reference descriptors, although both have the same "prefix". Here are the definitions:

type TPSCAN_Value_Descriptor = packed record
                                   Code : word ;
                                   MBO : word ; // Must be 1
                                   MBMO : cardinal ; // Must be -1
                                   Value : int64 ;
                                   Flags : int64 ;
                               end ;
     PPSCAN_Value_Descriptor = ^TPSCAN_Value_Descriptor ;

type TPSCAN_Reference_Descriptor = packed record
                                       Code : word ;
                                       MBO : word ; // Must be 1
                                       MBMO : cardinal ; // Must be -1
                                       Length : int64 ;
                                       Address : int64 ;
                                       Flags : int64 ;
                                   end ;
     PPSCAN_Reference_Descriptor = ^TPSCAN_Reference_Descriptor ;

If it were up to me, the two structures would be the same length, but we are following the VMS specification. Both structures contain an item code and flags. The value structure contains an integer value and the flags. The reference structure contains an address to a string/buffer and a length to that string. Because the structures are different sizes, our code is made a little more complicated.

            Item_Code := Value_Descriptor.Code ;
            if( Is_By_Reference( Item_Code ) ) then // Reference descriptor
            begin
                // Remap for reference descriptor...
                MMC.UnMap_Pages( 0, Address, Size ) ;
                MMC.Unlock_Pages( PID, Base, Size ) ;
                Size := sizeof( TPSCAN_Reference_Descriptor ) ;
                Offset := MMC.Lock_Pages( PID, ItemList, Size ) ;
                Base := MMC.Map_Pages( PID, 0, ItemList, Size, MAM_Read or MAM_Lock ) ;
                if( Base = 0 ) then // Couldn't map memory
                begin
                    if( MMC.Last_Error = nil ) then
                    begin
                        Create_Error( UOSErr_Memory_Address_Error ) ;
                    end ;
                    IOSB.r_io_64.w_status := UE_Error ;
                    MMC.UnMap_Pages( 0, Address, Size ) ;
                    Process_Context.Free ;
                    exit ;
                end ;
                Address := Base + Offset ;
                Reference_Descriptor := PPSCAN_Reference_Descriptor( Address ) ;
                if( ( Reference_Descriptor.Address < 16 ) or ( Reference_Descriptor.Length = 0 ) ) then
                begin
                    Create_Error( UOSErr_Bad_Parameter ) ;
                    IOSB.r_io_64.w_status := UE_Error ;
                    MMC.UnMap_Pages( 0, Address, Size ) ;
                    Process_Context.Free ;
                    exit ;
                end ; // if( Reference_Descriptor.Address = 0 )
                SRB.Buffer := Reference_Descriptor.Address ;
                SRB.Length := Reference_Descriptor.Length ;
                SRB.Flags := 0 ;
                US := Get_User_String( Kernel, PID, SRB, IOSB.r_io_64.w_status ) ;
                if( IOSB.r_io_64.w_status = UE_Error ) then
                begin
                    MMC.UnMap_Pages( 0, Address, Size ) ;
                    Process_Context.Free ;
                    if( US <> nil ) then
                    begin
                        US.Free ;
                    end ;
                    exit ;
                end ;
                S := As_UTF8( US ) ;
                US.Free ;
                Filter := TFilter.Create ;
                Filter.Selection_Criteria := Item_Code ;
                Filter.Value := S ;
                Filter.Qualifier := Reference_Descriptor.Flags ;
            end else

First we grab the item code from the descriptor. Remember, the first part of both types of descriptor are identical, so it won't matter if we have cast a reference descriptor as a value descriptor for the moment. The next thing we do is see if the item code indicates a reference descriptor. If so, we unmap the user memory and then remap it appropriately for the size of a reference descriptor. Then we map a reference descriptor and set Size to match this descriptor's size. We do a quick validation on the address and length. Length 0 is not allowed an any memory address less than 16 is assumed to be an error. If that validation fails we return an error and exit. Note that if the memory address is wrong, the attempt to map the memory will probably also generate an error. But we do this extra check in the hopes of returning a more meaningful error (bad parameter) than otherwise (invalid memory access).

Next we construct an SRB structure from the address and length in the descriptor so we can use the Get_User_String function to get the string value from the user memory, exiting if there was an error. The As_UTF8 function simply takes a UOS string and places it in a Pascal string variable as is. "As_UTF" indicates that we are treating the data as an UTF8 format and doing no processing on it (essentially treating it as binary data). The we create a filter and fill the fields appropriate from the descriptor and string we fetched from the user memory.

            begin
                Filter := TFilter.Create ;
                Filter.Selection_Criteria := Item_Code ;
                Filter.ValueI := Value_Descriptor.Value ;
                Filter.Qualifier := Value_Descriptor.Flags ;
            end ; // if

If the descriptor is a value descriptor, we simply create a filter and set the appropriate values.

            if( ( Filter.Qualifier and PSCAN_M_COMPARISON_MASK ) > PSCAN_M_NEQ ) then
            begin
                MMC.UnMap_Pages( 0, Address, Size ) ;
                Filter.Free ;
                Process_Context.Free ;
                Generate_Exception( UOSErr_Bad_Parameter ) ;
                exit ;
            end ;
            Process_Context.Filters.Add( Filter ) ;
            MMC.UnMap_Pages( 0, Address, Size ) ;
        finally
            MMC.Unlock_Pages( PID, Base, Size ) ;
        end ;
        ItemList := ItemList + Size ; // Move to next descriptor
    end ; // while( true )

VMS implements the comparison flags as individual flags, which allows such nonsense as PSCAN_M_EQL or PSCAN_M_NEQ. If VMS detects these conflicting flags, it returns an error. However, UOS implements the comparison values as a bit field which can be masked out of the qualifier value. Thus there cannot be weird comparison combinations. Oring the flags on UOS might result in an unintended comparison, but they are still valid. There exception being that the comparison mask is large enough for eight different values, but only six possible values are defined. So, we do check for a value that is out of range. If it is, we free the filter and context and return an error.
Finally, we add the filter to the context, unmap the user memory, increment the item list pointer, and then loop back for the next descriptor.

    // Write context value back...
    Process.Add_Context( Process_Context ) ;
    Write_User_int64( Kernel, PID, ContextAdr, integer( Process_Context ) or 1 ) ;
    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 ;
end ; // TUSC.Process_Scan_Context

Once we run out of descriptors, we exit the loop and then we add the new context object to the process. Then we write the context to the user's memory at the location they specified. Note that we set the lowest bit of the context address (or 1) as we discussed in the previous article. If trying to write to the user address fails and no error is already set, we set an exception.

In the next article we will review changes to the TProcess class. After that, we'll have an article revisiting Unicode, and then move on to lexical functions that make use of the Process_Scan system call.