I had hoped that we would be starting on the next CUSP in this article, however while updating documentation and putting the final touches on the binary distribution, I discovered that I had left something out of the previous articles on LIBRARY and LBR services. No excuse - it just slipped through the cracks. So we will address the LIBRARY/LIST functionality before we move on. /LIST was in the user documentation, so we won't reproduce that here.

    // List...
    if( List ) then
    begin
        fillchar( Descriptors, sizeof( Descriptors ), sizeof( Descriptors ) ) ;
        Descriptors[ 0 ].MBO := $FFFF ;
        Descriptors[ 0 ].MBMO := -1 ;
        Descriptors[ 0 ].Item_Code := LBI_FREE ;
        Descriptors[ 0 ].Buffer_Length := sizeof( int64 ) ;
        Descriptors[ 0 ].Buffer_Address := int64( @Free_Space ) ;
        Descriptors[ 0 ].Return_Length_Address := int64( @TempL ) ;
        Descriptors[ 1 ].MBO := $FFFF ;
        Descriptors[ 1 ].MBMO := -1 ;
        Descriptors[ 1 ].Item_Code := LBI_SIZE ;
        Descriptors[ 1 ].Buffer_Length := sizeof( int64 ) ;
        Descriptors[ 1 ].Buffer_Address := int64( @Total_Space ) ;
        Descriptors[ 1 ].Return_Length_Address := int64( @TempL ) ;
        GETLBI( Context, int64( @Descriptors ) ) ;
        Put_Output( 'Directory of ' + Type_Name( Typ ) + ' library ' +
            trim( UUI.Get_Component_By_Name( 'input' ).Text ) + ' on ' +
            ASCTIM( 0 ) ) ;
        Put_Output( 'Used space: ' + inttostr( Total_Space - Free_Space ) +
            '  Free space: ' + inttostr( Free_Space ) ) ;
        Search_Context := 0 ;
        setlength( ModName, 1024 ) ;
        Set_String( ModName, SRB ) ;
        SL := TStringList.Create ;
        while( SRB.Length > 0 ) do
        begin
            Find( Context, '*', Search_Context, SRB ) ;
            S := ModName ;
            setlength( S, SRB.Length ) ;
            SL.Add( S ) ;
            SRB.Length := 1024 ;
        end ;
        SL.Sort ;
        Put_Output( 'Number of modules: ' + inttostr( SL.Count ) ) ;
        for I := 0 to SL.Count - 1 do
        begin
            Put_Output( SL[ I ] ) ;
        end ;
        SL.Free ;
        Find_Close( Context, Search_Context ) ;
    end ; // if( List )

Next we loop through the modules in the library, building a list of them. Note that the order we get the modules back is unpredictable, thus we sort the list when done so that we can output the sorted list to the user. The Find function allows us to iterate through all modules until the returned length is 0. Finally, we clean up by freeing the list and calling Find_Close to free the search context. We will cover Find and Find_Close later in the article.

function Type_Name( Typ : integer ) : string ;

begin
    case Typ of
        LBR_C_TYP_HLP : Result := 'HELP' ;
        LBR_C_TYP_MLB : Result := 'MACRO' ;
        LBR_C_TYP_OBJ : Result := 'OBJECT' ;
        LBR_C_TYP_TXT : Result := 'TEXT' ;
        else Result := 'UNKNOWN' ;
    end ; // case Typ
end ;

function GetLBI( Context, List : int64 ) : int64 ;

begin
    Result := LBR_GetLBI( int64( @Context ), List ) ;
end ;


function Find( Context : int64 ; Name : string ; var Index : int64 ;
    var Res : TSRB ) : int64 ;

var SRB : TSRB ;

begin
    Set_String( Name, SRB ) ;
    Result := LBR_Find( int64( @Context ), int64( @SRB ), int64( @Index ), int64( @Res ) ) ;
end ;


function Find_Close( Context : int64 ; var Index : int64 ) : int64 ;

begin
    Result := LBR_Find_Close( int64( @Context ), int64( @Index ) ) ;
end ;

The three new LBR services called in the above code are not found in VMS. Apparently the VMS librarian grabs this information directly from the file without using an LBR service. We want to make sure that all UOS utilities (with only a couple of exceptions) derive all of their functionality from system services. That way a user can write their own utilities to do anything they want via documented services. Here is the user documentation for the three new LBR services.

Condition Codes Returned:
LBR_ILLCTL Specified context is not valid.
LBR_LIBNOTOPN Specified library is not open.
UOSErr_Missing_Value No index address was provided.
SS_NORMAL Successful completion.

LBR$Find_Close cleans up the context used by LBR$Find, including releasing any allocated memory.

Description Closes the context used by LBR$Find, which is specified by the value pointed to by index. Note that after this is done, using the context value with LBR$Find will result in an error.

Condition Codes Returned:
LBR_ILLCTL Specified context is not valid.
LBR_LIBNOTOPN Specified library is not open.
UOSErr_Missing_Value No index address was provided.
SS_NORMAL Successful completion.

Descriptors:

Offset byte	Size in bytes	Description
0	2	Must be -1
2	2	Item code
4	4	Must be -1
8	8	Result buffer address
16	8	Result buffer size
24	8	Result length

Description
Returns the requested information about a library. The following item codes are valid for the passed descriptor list:

Item	Return type	Information returned
LBI_FREE	integer	Total free space in library, in bytes.
LBI_SIZE	integer	Total size of the library, in bytes.

Condition Codes Returned:
LBR_ILLCTL Specified context is not valid.
LBR_LIBNOTOPN Specified library is not open.
LBR_NOTFOUND Specified module is not found in the library.
SS_BADPARAM An invalid item code was passed in a descriptor.
SS_NORMAL Successful completion.

Also, you may recall that we plan to use the FS$ services in LBR rather than directly accessing the file system. That is still the plan, but I haven't had time to make those changes yet, so the following code doesn't use FS$ services.

function LBR_GetLBI( Context, List : int64 ) : int64 ;

var Buff : PChar ;
    C : LBR_Context ;
    Descriptor : TSYS_Descriptor ;
    Offset : integer ;
    Size, Value : int64 ;

begin
    // Set up...
    Result := 0 ;
    if( Context = 0 ) then
    begin
        Result := LBR_ILLCTL ;
        exit ;
    end ;
    Context := Pint64( Context )^ ;
    if( Context = 0 ) then
    begin
        Result := LBR_ILLCTL ;
        exit ;
    end ;
    C := LBR_Context( Context ) ;
    if( C.Sanity <> #3'LBR' ) then
    begin
        Result := LBR_ILLCTL ;
        exit ;
    end ;
    if( not C.Opened ) then
    begin
        Result := LBR_LIBNOTOPN ;
        exit ;
    end ;
    if( List = 0 ) then
    begin
        exit ;
    end ;

    // Process the list...
    Buff := PAnsiChar( List ) ;
    Offset := 0 ;
    while( true ) do
    begin
        move( Buff[ Offset ], Descriptor, sizeof( Descriptor ) ) ;
        Offset := Offset + sizeof( Descriptor ) ;
        if(
            ( Descriptor.Buffer_Length = 0 )
            or
            ( Descriptor.Buffer_Address = 0 )
            or
            ( Descriptor.Return_Length_Address = 0 )
          ) then // End of list
        begin
            exit ;
        end ;
        if( Descriptor.Item_Code = LBI_SIZE ) then
        begin
            Value := C.FS.Store.Max_Storage ;
            move( Value, PChar( Descriptor.Buffer_Address )[ 0 ], sizeof( int64 ) ) ;
            if( Descriptor.Return_Length_Address <> 0 ) then
            begin
                Value := sizeof( int64 ) ;
                move( Value, PChar( Descriptor.Return_Length_Address )[ 0 ], sizeof( int64 ) ) ;
            end ;
        end else
        if( Descriptor.Item_Code = LBI_FREE ) then
        begin
            Value := C.FS.Store.SpaceAvail ;
            move( Value, PChar( Descriptor.Buffer_Address )[ 0 ], sizeof( int64 ) ) ;
            if( Descriptor.Return_Length_Address <> 0 ) then
            begin
                Value := sizeof( int64 ) ;
                move( Value, PChar( Descriptor.Return_Length_Address )[ 0 ], sizeof( int64 ) ) ;
            end ;
        end else
        begin
            Result := UOSErr_Bad_Parameter ;
            exit ;
        end ;
    end ;
end ; // LBR_Get_LBI

function LBR_Find( Context, Name, Index, Res : int64 ) : int64 ;

var C : LBR_Context ;
    I : int64 ;
    P : pointer ;
    S : string ;

begin
    // Set up...
    Result := 0 ;
    if( Context = 0 ) then
    begin
        Result := LBR_ILLCTL ;
        exit ;
    end ;
    Context := Pint64( Context )^ ;
    if( Context = 0 ) then
    begin
        Result := LBR_ILLCTL ;
        exit ;
    end ;
    C := LBR_Context( Context ) ;
    if( C.Sanity <> #3'LBR' ) then
    begin
        Result := LBR_ILLCTL ;
        exit ;
    end ;
    if( not C.Opened ) then
    begin
        Result := LBR_LIBNOTOPN ;
        exit ;
    end ;
    if( Index = 0 ) then
    begin
        Result := UOSErr_Missing_Value ;
        exit ;
    end ;
    if( Res = 0 ) then
    begin
        exit ;
    end ;
    I := Pint64( Index )^ ;
    if( ( Name = 0 ) or ( I <> 0 ) ) then
    begin
        S := '' ;
    end else
    begin
        S := Get_String( PSRB( Name )^ ) ;
    end ;

    // Do the lookup and return the data...
    P := pointer( I ) ;
    S := C.FS.Lookup( PChar( inttostr( C.Typ ) + '\' + S ), P ) ;
    if( length( S ) > PSRB( Res )^.Length ) then
    begin
        setlength( S, PSRB( Res )^.Length ) ;
    end ;
    move( PChar( S )[ 0 ], PChar( PSRB( Res )^.Buffer )[ 0 ], length( S ) ) ;
    PSRB( Res )^.Length := length( S ) ;
    I := integer( P ) ;
    PInt64( Index )^ := I ;
end ; // LBR_Find

You may note that we prefix the name with the library type (C.Typ) and a backslash. This is because, if you recall, a library file can have multiple types of modules in it and they are stored in a directory that is the number of the type. This guarantees that we will be searching within the directory that has the modules of the type we specified when we called LBR_INI_Control. So, if we open a help library, it will search for help modules and not object modules, for instsance.

function LBR_Find_Close( Context, Index : int64 ) : int64 ;

var C : LBR_Context ;
    P : pointer ;

begin
    // Set up...
    Result := 0 ;
    if( Context = 0 ) then
    begin
        Result := LBR_ILLCTL ;
        exit ;
    end ;
    Context := Pint64( Context )^ ;
    if( Context = 0 ) then
    begin
        Result := LBR_ILLCTL ;
        exit ;
    end ;
    C := LBR_Context( Context ) ;
    if( C.Sanity <> #3'LBR' ) then
    begin
        Result := LBR_ILLCTL ;
        exit ;
    end ;
    if( not C.Opened ) then
    begin
        Result := LBR_LIBNOTOPN ;
        exit ;
    end ;
    if( Index = 0 ) then
    begin
        Result := UOSErr_Missing_Value ;
        exit ;
    end ;

    // Clear the context...
    Index := PInt64( Index )^ ;
    P := pointer( Index ) ;
    C.FS.Clear_Context( P ) ;
end ; // LBR_Find_Close