LBR Services

In this article, we will start to address the LBR_ services.

unit LBRPas ;

interface

function Last_Error : int64 ;
function Ini_Control( var c : int64 ; func, typ : int64 ; name, default : string ;
    var Res : string ) : int64 ;
function Open( context : int64 ; Options : array of int64 ;
    name : string = '' ) : int64 ;
function Close( context : int64 ) : int64 ;
function Delete( context : int64 ; name : string ) : int64 ;
function Get_Module( context : int64 ; routine : int64 = 0 ;
    data : int64 = 0 ; key : string = '' ) : int64 ;
function Module_Exists( Context : int64 ; Name : string ) : boolean ;
function Put_Module( context : int64 ; name : string ; const module : string ) : int64 ;
function Close_Control( Context : int64 ) : int64 ;


implementation

uses // UOS...
     LBR, // LBR_*
     _UOS, // TSRB
     UOS_Util ; // Set_String

var _Last_Error : int64 = 0 ;

function Last_Error : int64 ;

begin
    Result := _Last_Error ;
end ;


function Ini_Control( var c : int64 ; func, typ : int64 ; name, default : string ;
    var Res : string ) : int64 ;

var _Name, _Default, _Res : TSRB ;
    Len : int64 ;
    R : string ;

begin
    // Setup...
    Set_String( name, _Name ) ;
    Set_String( default, _Default ) ;
    setlength( R, length( Name ) + length( Default ) ) ;
    Set_String( R, _Res ) ;
    Len := 0 ;

    Result := LBR_Ini_Control( int64( @c ), int64( @func ),
        int64( @typ ), int64( @_Name ), int64( @_Default ),
        int64( @_Res ), int64( @Len ) ) ;
    _Last_Error := Result ;
    Res := R ;
    setlength( Res, Len ) ;
end ;


function Open( context : int64 ; Options : array of int64 ;
    name : string = '' ) : int64 ;

var SRB : TSRB ;

begin
    Set_String( Name, SRB ) ;
    Result := LBR_Open( int64( @Context ), int64( @Options ), int64( @SRB ) ) ;
end ;


function Close( context : int64 ) : int64 ;

begin
    Result := LBR_Close( int64( @Context ) ) ;
end ;


function Delete( context : int64 ; name : string ) : int64 ;

var SRB : TSRB ;

begin
    Set_String( Name, SRB ) ;
    Result := LBR_Delete( int64( @Context ), int64( @SRB ) ) ;
end ;


function Get_Module( context : int64 ; routine : int64 = 0 ;
    data : int64 = 0 ; key : string = '' ) : int64 ;

var SRB : TSRB ;

begin
    Set_String( Key, SRB ) ;
    Result := LBR_Get_Module( int64( @Context ), Routine, Data, int64( @SRB ) ) ;
end ;


function Module_Exists( Context : int64 ; Name : string ) : boolean ;

var Res : int64 ;
    SRB : TSRB ;

begin
    Res := 0 ;
    Set_String( Name, SRB ) ;
    LBR_Module_Exists( int64( @Context ), int64( @SRB ), int64( @Res ) ) ;
    Result := ( Res <> 0 ) ;
end ;


function Put_Module( context : int64 ; name : string ; const module : string ) : int64 ;

var SName, SModule : TSRB ;

begin
    Set_String( name, SName ) ;
    Set_String( module, SModule ) ;
    Result := LBR_Put_Module( int64( @Context ), int64( @SName ), int64( @SModule ) ) ;
end ;


function Close_Control( Context : int64 ) : int64 ;

begin
    Result := LBR_Close_Control( int64( @Context ) ) ;
end ;


end.

This is the complete code (thus far) of the LBRPas module, which is a wrapper for the LBR module for Pascal. It simply wraps and unwraps Pascal strings to/from TSRB structures, as well as passing pointers to data. Non-Pascal code would directly call the LBR module.

type TStore64_To_UOS_File_Bridge = class( TCOM_Store64 )
                       public // Instance data...
                           _File : TCOM_UOS_File ;

                       public { API... }
                           function Is_Class( N : PChar ) : boolean ;
                               override ; stdcall ;

                           function Read_Data( var Data ; Address, _Size : TStore_Address64 ;
                               var UEC : TUnified_Exception ) : TStore_Address64 ;
                               override ; stdcall ;
                           { Read data from specified Address in store to Data.
                             Read _Size bytes.  Returns success of operation in UEC.
                             Function returns the number of bytes actually read. }

                           function Write_Data( var Data ; Address, _Size : TStore_Address64 ;
                               var UEC : TUnified_Exception ) : TStore_Address64 ;
                               override ; stdcall ;
                           { Write data from Data to specified Address in store.
                             Write _Size bytes.  Returns success of operation in UEC.
                             Function returns the number of bytes actually written. }

                           function Max_Storage : TStore_Size64 ;
                               override ; stdcall ;
                           { Returns the maximum (current) size of the store, in
                             bytes.  In other words, this is the highest valid
                             address (plus 1). }

                           function Min_Storage : TStore_Address64 ;
                               override ; stdcall ;
                           { Returns the minimum atomic size of the store.  For
                             instance, this would be the sector size for a disk. }

                           function Extend( Amount : TStore_Address64 ) : TStore_Address64 ;
                               override ; stdcall ;
                           { Requests extension of store by the amount specified.
                             Returns the amount actually added to store.  If Amount
                             is 0, function returns 0 if store is extendable, and -1
                             if it is not. }

                           function Get_Read_Only : boolean ;
                               override ; stdcall ;
                           { Indicates that the store can only be read from. }

                           function Get_Write_Only : boolean ;
                               override ; stdcall ;
                           { Indicates that the store can only be written to. }

                           procedure Format ; override ; stdcall ;
                           { Does a low-level format of the store. }

                           function Get_Name : Pchar ;
                               override ; stdcall ;
                           { Returns name of store. }

                           function Get_Cache : TCOM_Cache64 ;
                               override ; stdcall ;
                           { Returns current cache object. }

                           procedure Set_Cache( Value : TCOM_Cache64 ) ;
                               override ; stdcall ;
                           { Sets the current cache object. }

                           function Contiguous_Store : boolean ;
                               override ; stdcall ;
                           { Returns True if the store's addresses are contiguous
                             (non-sparse). }

                           procedure Set_Max_Storage( Value : TStore_Address64 ;
                               var Res : TUnified_Exception ) ;
                               override ; stdcall ;
                           { Sets the maximum (current) size of the store, in bytes.
                             In other words, this is the new highest valid address
                             (plus 1).  If the store is not resizable, the call
                             fails and an error code is returned in Res.  This should
                             only be used to shrink the size of the store, not to
                             extend it.  To extend, use the Extend method. }

                           function Extended_Size : TStore_Address64 ;
                               override ; stdcall ;
                           { Returns the maximum theoretical size that the store can
                             be extended to.  If the store is not extendable, this
                             returns the same value as Max_Storage. }

                           function Get_Bytes_Read : longint ;
                               override ; stdcall ;
                           function Get_Bytes_Written : longint ;
                               override ; stdcall ;
                           function Get_Reads : longint ;
                               override ; stdcall ;
                           function Get_Writes : longint ;
                               override ; stdcall ;
                           function Get_Error_Count : longint ;
                               override ; stdcall ;
                           procedure Set_Bytes_Read( Value : longint ) ;
                               override ; stdcall ;
                           procedure Set_Bytes_Written( Value : longint ) ;
                               override ; stdcall ;
                           procedure Set_Reads( Value : longint ) ;
                               override ; stdcall ;
                           procedure Set_Writes( Value : longint ) ;
                               override ; stdcall ;
                           procedure Set_Error_Count( Value : longint ) ;
                               override ; stdcall ;
                           procedure Set_Read_Only( Value : boolean ) ;
                               override ; stdcall ;
                           procedure Set_Write_Only( Value : boolean ) ;
                               override ; stdcall ;
                           function Get_Verifier : TCOM_Managed_Store64_Debugger ;
                               override ; stdcall ;
                           procedure Set_Verifier( Value : TCOM_Managed_Store64_Debugger ) ;
                               override ; stdcall ;
                   end ; // TStore64_To_UOS_File_Bridge

This is a file wrapper. The reason this is needed is because the executive uses one type of file which is shared with the file systems. Ring 3 code uses a file class that wraps calls to the various FIP services in the executive. In this case, however, we are accessing the file system code, using a ring 3 file as the store on which the file system operates. So, this class has the file system interface, but internally remaps all the calls to a ring 3 file. This is because the LBR services are in Ring 3 instead of the executive. We call this a "bridge" because it is bridging between the two types of files.

function TStore64_To_UOS_File_Bridge.Is_Class( N : PChar ) : boolean ;

var _N : string ;

begin
    _N := lowercase( string( N ) ) ;
    Result := ( _N = 'tstore64_to_uos_file_bridge' ) ;
end ;


function TStore64_To_UOS_File_Bridge.Read_Data( var Data ; Address,
    _Size : TStore_Address64 ;
    var UEC : TUnified_Exception ) : TStore_Address64 ;

begin
    Result := _File.Read_Data( Data, Address, _Size, UEC ) ;
end ;


function TStore64_To_UOS_File_Bridge.Write_Data( var Data ;
    Address, _Size : TStore_Address64 ;
    var UEC : TUnified_Exception ) : TStore_Address64 ;

begin
    Result := _File.Write_Data( Data, Address, _Size, UEC ) ;
end ;


function TStore64_To_UOS_File_Bridge.Max_Storage : TStore_Size64 ;

begin
    Result := _File.Get_Size ;
end ;


function TStore64_To_UOS_File_Bridge.Min_Storage : TStore_Address64 ;

begin
    Result := 512 ;
end ;


function TStore64_To_UOS_File_Bridge.Extend( Amount : TStore_Address64 ) : TStore_Address64 ;

var Buffer : array[ 0..32767 ] of byte ;
    Count : TStore_Address64 ;
    UEC : TUnified_Exception ;

begin
    fillchar( Buffer, sizeof( Buffer ), 0 ) ;
    Result := 0 ;
    while( Amount > 0 ) do
    begin
        if( Amount > sizeof( Buffer ) ) then
        begin
            Count := sizeof( Buffer ) ;
        end else
        begin
            Count := Amount ;
        end ;
        Result := Result + Write_Data( Buffer, Max_Storage, Count, UEC ) ;
        if( UEC <> nil ) then
        begin
            exit ;
        end ;
        Amount := Amount - Count ;
    end ;
end ;


function TStore64_To_UOS_File_Bridge.Get_Read_Only : boolean ;

begin
    Result := False ;
end ;


function TStore64_To_UOS_File_Bridge.Get_Write_Only : boolean ;

begin
    Result := False ;
end ;


procedure TStore64_To_UOS_File_Bridge.Format ;

begin
end ;


function TStore64_To_UOS_File_Bridge.Get_Name : Pchar ;

begin
    Result := nil ;
end ;


function TStore64_To_UOS_File_Bridge.Get_Cache : TCOM_Cache64 ;

begin
    Result := nil ;
end ;


procedure TStore64_To_UOS_File_Bridge.Set_Cache( Value : TCOM_Cache64 ) ;

begin
end ;


function TStore64_To_UOS_File_Bridge.Contiguous_Store : boolean ;

begin
    Result := False ;
end ;


procedure TStore64_To_UOS_File_Bridge.Set_Max_Storage( Value : TStore_Address64 ;
   var Res : TUnified_Exception ) ;

begin
    Res := nil ;
    _File.Set_Size( Value ) ;
end ;


function TStore64_To_UOS_File_Bridge.Extended_Size : TStore_Address64 ;

begin
    Result := 0 ;
    //todo:return available space on store contaning the file
end ;


function TStore64_To_UOS_File_Bridge.Get_Bytes_Read : longint ;

begin
    Result := 0 ;
end ;


function TStore64_To_UOS_File_Bridge.Get_Bytes_Written : longint ;

begin
    Result := 0 ;
end ;


function TStore64_To_UOS_File_Bridge.Get_Reads : longint ;

begin
    Result := 0 ;
end ;


function TStore64_To_UOS_File_Bridge.Get_Writes : longint ;

begin
    Result := 0 ;
end ;


function TStore64_To_UOS_File_Bridge.Get_Error_Count : longint ;

begin
    Result := 0 ;
end ;


procedure TStore64_To_UOS_File_Bridge.Set_Bytes_Read( Value : longint ) ;

begin
end ;


procedure TStore64_To_UOS_File_Bridge.Set_Bytes_Written( Value : longint ) ;

begin
end ;


procedure TStore64_To_UOS_File_Bridge.Set_Reads( Value : longint ) ;

begin
end ;


procedure TStore64_To_UOS_File_Bridge.Set_Writes( Value : longint ) ;

begin
end ;


procedure TStore64_To_UOS_File_Bridge.Set_Error_Count( Value : longint ) ;

begin
end ;


procedure TStore64_To_UOS_File_Bridge.Set_Read_Only( Value : boolean ) ;

begin
end ;


procedure TStore64_To_UOS_File_Bridge.Set_Write_Only( Value : boolean ) ;

begin
end ;


function TStore64_To_UOS_File_Bridge.Get_Verifier : TCOM_Managed_Store64_Debugger ;

begin
    Result := nil ;
end ;


procedure TStore64_To_UOS_File_Bridge.Set_Verifier( Value : TCOM_Managed_Store64_Debugger ) ;

begin
end ;

This is the implementation for the file bridge class in LBR. We won't bother to go over it in detail since there isn't anything unusual here. We simply pass the requests on to the file instance that we are wrapping.

type LBR_Context = class
                       public
                           Sanity : array[ 0..3 ] of char ;
                           Name : string ;
                           Typ : int64 ;
                           Fun : int64 ;
                           FS : TUOS_Native_File_System ;
                           Opened : boolean ;
                   end ;

As mentioned in the documentation in the previous article, the LBR routines depend upon a context created by LBR_Ini_Control. This class defines the context used by the LBR services. Frankly, the whole approach of the VMS LBR services is somewhat unwieldly. But in the attempt to stay true to the VMS specification (at least as much as is reasonable), we have copied this approach for UOS.

function LBR_Ini_Control( context, func, typ, name, default, res, len : int64 ) : int64 ;

var C : LBR_Context ;
    _Name, _Default, _Res : string ;

begin
    // Setup...
    if( Func <> 0 ) then
    begin
        Func := PInt64( Func )^ ;
    end ;
    if( Typ <> 0 ) then
    begin
        Typ := PInt64( Typ )^ ;
    end ;
    if( ( Func < LBR_C_Create ) or ( Func > LBR_C_Update ) ) then
    begin
        Result := LBR_ILLFUNC ;
        if( Context <> 0 ) then
        begin
            PInt64( Context )^ := 0 ;
        end ;
        exit ;
    end ;
    if( ( Typ > LBR_C_TYP_NCS ) or ( Typ = 0 )  ) then
    begin
        Result := LBR_ILLTYP ;
        if( Context <> 0 ) then
        begin
            PInt64( Context )^ := 0 ;
        end ;
        exit ;
    end ;
    Result := 0 ;
    _Name := trim( Get_String( PSRB( name )^ ) ) ;
    _Default := trim( Get_String( PSRB( Default )^ ) ) ;
    _Res := Substitute_Wildcards( _Name, '', _Default ) ;
    if( ( _Name = '' ) or ( _Res = '' ) ) then
    begin
        Result := LBR_NOFILNAM ;
        if( Context <> 0 ) then
        begin
            PInt64( Context )^ := 0 ;
        end ;
        exit ;
    end ;

LBR_Ini_Control creates the control class and returns it to the caller. This code gets and validates the passed parameters. It constructs the libary name from the passed name and defaults.

    // Create the context...
    if( Context <> 0 ) then
    begin
        C := LBR_Context.Create ;
        C.Name := _Name ;
        C.Typ := Typ ;
        C.Fun := Func ;
        C.Sanity := #3'LBR' ;
        Pint64( Context )^ := int64( C ) ;
    end ;

    // Return results...
    if( Res <> 0 ) then
    begin
        if( length( _Res ) > PSRB( Res )^.Length  ) then
        begin
            setlength( _Res, PSRB( Res )^.Length ) ;
        end ;
        move( PChar( _Res )[ 0 ], PChar( PSRB( Res )^.Buffer )[ 0 ], length( _Res ) ) ;
    end else
    begin
        _Res := '' ;
    end ;
    if( Len <> 0 ) then
    begin
        PInt64( Len )^ := length( _Res ) ;
    end ;
end ; // LBR_Ini_Control

Next we construct the class, then return the name with defaults applied. If the return buffer size is too small, we truncate the result and no error is returned. If a length result was requested, we return the actual size of the returned name. Note that the Sanity data in the LBR_Context class is there to help be sure that what is passed to the LBR routines is a valid instance of the class.

function LBR_Open( context : int64 ; options : int64 = 0 ; name : int64 = 0 ) : int64 ;

var Allocation, Clustersize : int64 ;
    AT_Offset : TStore_Address64 ;
    Bridge : TStore64_To_UOS_File_Bridge ;
    Buffer : array[ 0..32767 ] of byte ;
    C : LBR_Context ;
    Err, Flags : int64 ;
    NFil : TUOS_File ;
    Fil : TCOM_UOS_File ;
    Info : TUOS_File_Info ;
    _Name : string ;
    P : int64 ;
    UEC : TUnified_Exception ;

begin
    // Sanity checks...
    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( C.Opened ) then
    begin
        Result := LBR_LIBOPN ;
        exit ;
    end ;

This service opens a library. First we get the context and validate it.

    // Setup...
    Allocation := 8192 ; // Default size of new library
    Clustersize := 0 ;
    if( Options <> 0 ) then
    begin
        Allocation := PInt64( Options )^ ;
        Clustersize := PInt64( Options + 8 )^ ;
    end ;
    _Name := '' ;
    if( name <> 0 ) then
    begin
        _Name := trim( Get_String( PSRB( name )^ ) ) ;
    end ;
    if( _Name = '' ) then
    begin
        _Name := C.Name ;
    end ;

Next we get the other parameters. We default to 8K for the initial size of the library (if we're creating a new library).

    // Open/create the file...
    Flags := 0 ;
    if( C.Fun = LBR_C_Create ) then
    begin
        Flags := FAB_V_SUP or FAB_V_CIF ;
    end else
    if( C.Fun = LBR_C_Read ) then
    begin
        Flags := FAB_V_GET ;
    end else
    begin
        Flags := FAB_V_UPD ;
    end ;
    Fil := Open_Binary_File( _Name, Flags ) ;
    if( Fil = nil ) then // Open failed
    begin
        Err := LIB_Get_Exception( 0 ) ;
        Result := LIB_Get_Exception_Code( 0, Err ) ;
        exit ;
    end ;
    if( C.Fun = LBR_C_Create ) then // Creating new file...
    begin
        // Expand the file to the requested allocation size...
        fillchar( Buffer, sizeof( Buffer ), 0 ) ;
        P := 0 ;
        while( Allocation > 0 ) do
        begin
            if( Allocation < sizeof( Buffer ) ) then
            begin
                Fil.Write_Data( Buffer, P, Allocation, UEC ) ;
            end else
            begin
                Fil.Write_Data( Buffer, P, sizeof( Buffer ), UEC ) ;
            end ;
            if( ( UEC <> nil ) and ( UEC.Get_Error <> 0 ) ) then
            begin
                Result := UEC.Get_Error ;
                exit ;
            end ;
            Allocation := Allocation - sizeof( Buffer ) ;
            P := P + sizeof( Buffer ) ;
        end ;
    end ; // if( C.Fun = LBR_C_Create )

Now we determine the flags to pass to the Open_Binary_File routine based on the function given in LBR_Ini_Control. If the file fails to open, we return the error. Otherwise, if we are creating a new library, we have to extend the file to the appropriate size.

    C.FS := TUOS_Native_File_System.Create ;
    C.FS.Store := TUOS_Managed_Store.Create ;
    Bridge := TStore64_To_UOS_File_Bridge.Create ;
    Bridge._File := Fil ;
    C.FS.Store.Store := Bridge ;
    C.Opened := True ;
    if( C.Fun = LBR_C_Create ) then // Need to initialize the file
    begin
        AT_Offset := 0 ; // Use default position
        C.FS.Init( nil, nil, 0, Clustersize, Clustersize, 0, AT_Offset, nil ) ;
    end ;
    UEC := C.FS.Mount( nil, nil, 0 ) ;
    if( UEC <> nil ) then
    begin
        if( UEC.Get_Error = UOS_File_System_Is_Dirty ) then
        begin
            C.FS.Rebuild ;
            UEC := C.FS.Mount( nil, nil, 0 ) ; // Try again
            if( UEC <> nil ) then
            begin
                if( UEC.Get_Error <> 0 ) then
                begin
                    Result := UEC.Get_Error ;
                    exit ;
                end ;
            end ;
        end else
        if( UEC.Get_Error <> 0 ) then
        begin
            Result := UEC.Get_Error ;
            exit ;
        end ;
    end ; // if( UEC <> nil ) then

Now that we have a newly created or pre-existing file, we create a file system object, managed store, and bridged file store so that we can open the file as a file system file. Then we mount the file system. Note that because this is a file system within a file, it is possible that the file system would be "dirty" if we didn't close it properly before (such as the librarian ending before an operation is complete). If we get a dirty file system error, we tell the file system to rebuild, and then try to mount it again. If there is any further error, we exit and return the error.

    // Create root directory, if none...
    fillchar( Info, sizeof( Info ), 0 ) ;
    Info.Flags := FAF_DIRECTORY ;
    C.FS.Create_File( PChar( inttostr( C.Typ ) ), Info ) ;
    Result := 0 ;
end ; // LBR_Open

Finally, we make sure to create the root for the library type. Because UOS libraries can have multiple types of modules, there can be a directory for each type. This code ensures that the appropriate directory exists. If it already exists, the call will fail, but we don't care about that.

function LBR_Close( context : int64 ) : int64 ;

var C : LBR_Context ;

begin
    // Sanity checks...
    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 ;
    C.FS.Dismount ;
    C.FS.Free ;
    C.Opened := False ;
end ;

After verifying a correct control, this routine dismounts and closes the open file system for the given context.

function LBR_Delete( context, name : int64 ) : int64 ;

var C : LBR_Context ;
    _Name : string ;
    UEC : TUnified_Exception ;

begin
    // Sanity checks...
    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 ;
    _Name := '' ;
    if( name <> 0 ) then
    begin
        _Name := trim( Get_String( PSRB( name )^ ) ) ;
    end ;
    if( _Name = '' ) then
    begin
        Result := LBR_INVNAME ;
        exit ;
    end ;
    if( pos( '\', _Name ) + pos( ':', _Name ) + pos( '*', _Name ) + pos( '?', _Name ) > 0 ) then
    begin
        Result := LBR_INVNAME ;
        exit ;
    end ;
    _Name := inttostr( C.Typ ) + '\' + _Name ;

As with the last service, we first get and validate the context, and obtain the other parameters. We prefix the module name with the root directory based on the type from the context.

    // Delete the module...
    Result := 0 ;
    UEC := C.FS.Delete_File( PChar( _Name ) ) ;
    if( ( UEC <> nil ) and ( UEC.Get_Error <> 0 ) ) then
    begin
        Result := UEC.Get_Error ;
        UEC.Detach ;
    end ;
end ; // LBR_Delete

Finally, we tell the file system to delete the module, returning any errors.

function LBR_Put_Module( context, name, module : int64 ) : int64 ;

var C : LBR_Context ;
    Fil : TUOS_Native_File_System ;
    NFil : TUOS_File ;
    Info : TUOS_File_Info ;
    _Name : string ;
    Size, Address : int64 ;
    UEC : TUnified_Exception ;

begin
    // Sanity checks...
    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 ;
    _Name := '' ;
    if( name <> 0 ) then
    begin
        _Name := trim( Get_String( PSRB( name )^ ) ) ;
    end ;
    if( _Name = '' ) then
    begin
        Result := LBR_INVNAME ;
        exit ;
    end ;
    if( pos( '\', _Name ) + pos( ':', _Name ) + pos( '*', _Name ) + pos( '?', _Name ) > 0 ) then
    begin
        Result := LBR_INVNAME ;
        exit ;
    end ;
    Size := 0 ;
    Address := 0 ;
    if( module <> 0 ) then
    begin
        Size := PSRB( Module )^.Length ;
        Address := PSRB( Module )^.Buffer ;
    end ;
    _Name := inttostr( C.Typ ) + '\' + _Name ;

As before, we get the parameters, and validate the context. Then we prefix the module name with the root directory based on the library type.

    // Create new module...
    C.FS.Delete_File( PChar( _Name ) ) ; // Delete any existing file
    fillchar( Info, sizeof( Info ), 0 ) ;
    Info.Size := Size ;
    C.FS.Create_File( PChar( _Name ), Info ) ;

    // Open file...
    NFil := C.FS.Get_File( PChar( _Name ) ) ;
    if( NFil = nil ) then
    begin
        UEC := C.FS.Last_Error ;
        Result := UEC.Get_Error ;
        exit ;
    end ;

    // Write data to file...
    if( NFil.Write( 0, 0, Size, PChar( Address )[ 0 ], 0 ) <> Size ) then
    begin
        UEC := C.FS.Last_Error ;
        Result := UEC.Get_Error ;
        exit ;
    end ;

    // Clean up
    NFil.Free ;
end ; // LBR_Put_Module

Next we delete the file if it already exists. Then we create a new one and write the module data to it. Why not just write over the existing file if there is one? Because if the existing file is larger, we'd only overwrite the first part of the file. The file would thus take up more space than necessary and, when extracted, would be too large and have excess data at the end.

These are the generic LBR functions that we discussed in the documentation. In the next article, we will look at the help-specific services (and a few others not yet documented).