More Fun With Stores: File Heaps

Introduction
We have looked at several different uses of stores in past articles. As we have seen, a store can be any physical or logical device that can store data. Now that we have a working file system and the ability to access files, we can use files as stores themselves. So far, the stores we've seen were fixed in size, once they were created (or by virtue of the physical device itself). We can also do this with a file store. In fact, when we evenutally talk about running UOS virtually, we will be using files to store fixed-size virtual disks. But the true advantage to using a file as a store is that we can resize the file and, thus, the store. The ability of files to be either static or dynamically-sized makes them very flexible for stores.

We've used managed stores in memory both for virtual disks (static sizes), and heaps (dynamic sizes). A file heap is an analog to the memory heap. The use of a file heap allows us to store complex structures in a file while making an economical use of space in the file system's store. Because file heaps are dynamically-sized, the files only grow as large as necessary to store the necessary data (with a little bit of overhead). This means that we don't need to predict the final size of the file, or waste space that may never be used.

Managed store changes
So far, the UOS Managed Store class assumed a static-sized store. We need to alter the class to handle a resizable store. We will only resize the store to be larger - we won't try to shrink it in size when releasing allocations. There are several reasons for this, but the two most important are: 1) it is very complicated to recover space in a file heap, and we want to leave the executive as simple as possible, and 2) in a heap that is being used enough to have allocations and deallocations, we are likely to have to extend the heap again, so we would likely have better performance if we leave the space in the file and reuse it when needed. Therefore, we only need to modify the Allocate method.
Here are the changes to the Allocate code:

function TUOS_Managed_Store.Allocate( Size : TStore_Address64 ) : TStore_Address64 ;

var Calculating : boolean ;
    Original : int64 ;
    Previous_New_AT_Size : int64 ;
    Needed_Extension : int64 ; // Amount of extension needed
    New_AT_Size, Old_AT_Size : int64 ; // Number of bytes for new and old AT
    New_AT : int64 ;
    Res : TUnified_Exception ;
    Unused_Bits, Total_Bits : longint ;

begin
    Result := AT.Allocate( Size ) ;
    Set_Last_Error( AT.Last_Error ) ;
    if( ( Result = 0 ) and ( Extend( 0 ) = 0 ) ) then // Allocation failure on extendable store
    begin

We ask the allocation table to allocate the space, as before, and clear any errors. The if statement is the first line of the new code. If the result of the call to the allocation table Allocate method is 0, it means the allocation failed due to a lack of free space. If this is true, and the store is extendable, then we will extend it. The purpose of the Extend method of stores (when passed a 0) is to indicate whether or not the store can be resized. If it returns 0, then we know it can be. If either case is false, we return the result and exit.

        // Extend the store...
        New_AT := 0 ;
        Needed_Extension := ( Size + _Store.Min_Storage - 1 ) and not ( _Store.Min_Storage - 1 ) ;
        Old_AT_Size := ( _Store.Max_Storage div _Store.Min_Storage + 7 ) div 8 ;
        Old_AT_Size := ( Old_At_Size + _Store.Min_Storage - 1 ) and not ( _Store.Min_Storage - 1 ) ;
        New_AT_Size := ( ( _Store.Max_Storage + Needed_Extension ) div _Store.Min_Storage + 7 ) div 8 ;
        New_AT_Size := ( New_At_Size + _Store.Min_Storage - 1 ) and not ( _Store.Min_Storage - 1 ) ;
        if( Allocation_Table_Offset <> 0 ) then // If AT is persisted to the store
        begin
            Previous_New_AT_Size := 0 ; // So that only differential is added
            Calculating := True ; // Execute loop at least once
            while( Calculating ) do
            begin
                Calculating := False ; // Assume that one iteration is enough
                if( Old_AT_Size < New_AT_Size ) then // If new AT requires more clusters than the old
                begin
                    New_AT := AT.Reallocate( Allocation_Table_Offset, Old_AT_Size, New_AT_Size ) ;
                    // See if we can allocate in existing free space
                    if( New_AT = 0 ) then // No existing room for new AT
                    begin
                        Needed_Extension := Needed_Extension + New_AT_Size - Previous_New_AT_Size ;
                        // Room for AT also
                        Previous_New_AT_Size := New_AT_Size ;
                        New_AT_Size := ( _Store.Max_Storage + Needed_Extension )
                            div _Store.Min_Storage div 8 ;
                        New_AT_Size := ( New_At_Size + _Store.Min_Storage - 1 )
                            and not ( _Store.Min_Storage - 1 ) ; // Round up
                        Calculating := True ; // Calculate again
                    end ;
                end ;
            end ; // while( Calculating )
        end ; // if( Allocation_Table_Offset <> 0 )

When we are extending the store, the first order of business is to calculate the current (old) AT size, and the minimum new AT size that would be required if we extend the store by the amount of the requested allocation. We do this because if the AT needs to grow so that it requires more clusters than before, we also need to allocate the space for the larger allocation table itself. If the allocation table offset is non-zero, that means that the allocation table has already been written to the store, so we will need to either extend it in-place (if possible) or write it to a new location that is large enough to hold the new table (if it hasn't been written out, we can just extend it in memory). But this creates a bit of a catch-22: having to allocate new room for the AT means that we have to extend the file by that much more space than was requested. Of course, making the file store larger means that the AT may have to be larger to be able to map the additional clusters. And that means that the space required for the file also increases. Fortunately, since the AT maps far more clusters than it requires, this loop eventually ends with a total size that meets both the AT requirements and the original request. Usually, we only need to go through the loop once, but depending upon the size of the file, the request, and the AT, it might take two or more loops. We loop for as long as we are calculating the new size (Calculating = true). At the start of the loop, we set Calculating to false and only set it back to true if we need another trip through the loop. If the new AT size requires more clusters than the old one, we first see if we can reallocate within our current AT. If we can, we don't need to add the new AT size to the store extension, and we are done with the loop. Otherwise (New_AT=0), we must add the new AT size to the extension. Since we may be going through the loop a second time, we don't want to add in the length of the new AT again (it was already added in the previous loop), so we only add the difference between the AT size calculated in this iteration and its size in the previous loop. In this case, the file will now be larger, so we recaluclate the new AT size (which may be the same number of bytes as before), and set Calculating to True so that we go through the loop once more to make sure that we are extending the store by enough. Needed_Extension will be the total amount we need to extend the store by when we are done looping.

I should point out that the managed store normally doesn't manage the allocation table on the store. That is left up to the code that manages the structure on the store (such as the file system). However, we make an exception in the case of extendable stores. In this case, we are extending the store, which implies that the allocation table is extended as well. And since the size of the AT changes, it must be updated on the store. So, we will update the on-store table in this routine. Note: if the calling code doesn't want this to happen, it can set the allocation offset to 0, which prevents this class from updating the AT, except in memory.

    if( ( New_AT_Size - Old_AT_Size ) * 8 * _Store.Min_Storage > Needed_Extension ) then
    begin
        Needed_Extension := ( New_AT_Size - Old_AT_Size ) * 8 * _Store.Min_Storage ;
    end ;
    Original := _Store.Max_Storage ;
    if( Original = Allocation_Table_Offset ) then // AT isn't yet physically written
    begin
        Original := Allocation_Table_Offset +
            Round_Up( AT.Size, _Store.Min_Storage ) ; // Start after AT
    end ;
    Original := Round_Up( Original, _Store.Min_Storage ) ;

The point of the first conditional is optional; the code would work fine without it. However, it insures that we extend the store in multiples of what a cluster-worth of allocation table mapping. The purpose is to reduce the number of extensions required by extending the store by slightly more than necessary for the current allocation request.
Original is set to the current size of the store. Because the allocation table may not have already been physically written to the store, we check to see if the current size is only up to the allocation table offset. If so, we adjust the original size to include the implied presence of the AT. Then we make sure that the original size is rounded up to a full cluster.

    if( Extend( Needed_Extension ) >= Needed_Extension ) then // Successful
    begin
        // Adjust AT bits...
        Total_Bits := AT.Get_Size * 8 ;
        Unused_Bits := Total_Bits - ( Original div _Store.Min_Storage ) ;
        if( Unused_Bits > 0 ) then // Need to clear bits
        begin
            if( ( Needed_Extension + _Store.Min_Storage - 1 ) div _Store.Min_Storage < Unused_Bits ) then
            begin
                Unused_Bits := ( Needed_Extension + _Store.Min_Storage - 1 )
                    div _Store.Min_Storage ;
            end ;
            AT.Deallocate( Original, Unused_Bits * _Store.Min_Storage ) ;
        end ;

Next we call the Extend method to extend the store (which just calls the store's Extend method). If the amount extended was the amount requested, we need to process the AT. Otherwise (for instance, if there was no room on the file's store to extend the file by the required amount) we just fall through to the end of the method and return a nil to indicate an allocation failure.
Because the previous size of the store might have been less than the amount of space mapped by the AT, there may be some bits set in the table to mark space beyond the end of the store as "allocated". Now that we've extended the size of the store, we need to clear those bits so that the newly available space can be allocated. So, we calculate the total number of clusters that the AT can map (the AT size times 8 bits), and the number of "unused" bits/clusters that had been marked as unavailable. If Unused_Bits is more than 0, we need to clear those bits. But before we do that, we have to make sure that we don't clear more bits than the available clusters in the store. This shouldn't happen since we always extend the store in a way that ensures the space mapped by the AT equals the size of the store (as discussed above). But, as I said, the code works even if that optional bit of code were left out. Finally, we can tell the AT to clear (deallocate) the space mapped by the new clusters in the store.

    AT.Set_Size( ( ( _Store.Max_Storage div _Store.Min_Storage ) + 7 ) div 8 ) ;
    Total_Bits := AT.Get_Size * 8 ;
    Unused_Bits := Total_Bits -
        ( Round_Up( _Store.Max_Storage, _Store.Min_Storage ) div _Store.Min_Storage ) ;
    if( Unused_Bits > 0 ) then // Need to set bits mapping beyond end of store
    begin
        AT.Allocate_At( ( Total_Bits - Unused_Bits ) * _Store.Min_Storage,
            Unused_Bits * _Store.Min_Storage ) ;
    end ;

Now that we've cleared any set allocation bits that no longer need to be set, we adjust the size of the allocation table in memory (rounded up to the next 8 bit boundary. Again, the following code isn't executed since we extend the store by an amount that exactly matches the AT size, but it is here in case we were to remove that code. We must make sure that any bits that map beyond the end of the store are set so that we don't allocate space outside the bounds of the store.

    // Flush allocation table...
    if( New_AT = 0 ) then // AT wasn't already reallocated
    begin
        New_AT := AT.Reallocate( Allocation_Table_Offset, Old_AT_Size, New_AT_Size ) ;
        if( New_AT = 0 ) then // No existing room for new AT
        begin
            Result := 0 ;
            Set_Last_Error( Create_Exception( UOS_AT_Resize_Failure, nil ) ) ;
            _Store.Set_Max_Storage( Original, Res ) ;
            exit ;
        end ;
    end ;

if New_AT is 0, that means our earlier attempt to reallocate the allocation table failed. So now that we've extended the store, we do the reallocation. If this reallocation also fails (which it shouldn't) then we return the store to its original size and return an error.

            Allocation_Table_Offset := New_AT ;
            AT.Flush ;

            // Try allocation again...
            Result := AT.Allocate( Size ) ;
            Set_Last_Error( AT.Last_Error ) ;
        end ; // if
    end ; // if

Finally, we set the allocation table offset and then flush the AT to the store. Then we attempt to fulfill the original allocation request from our newly extended store, and return the result.

    if( Last_Error = nil ) then
    begin
        inc( Statistics.Allocations ) ;
        Statistics.Bytes_Allocated := Statistics.Bytes_Allocated + Size ;
    end ;
end ; // TUOS_Managed_Store.Allocate

The rest of the method is the same as before: if we succeeded, increment the allocation statistics.

The File Store
Now that the UOS managed store class can handle extendable stores, we turn our attention to the File Store class. This class implements a store that is actually a file. That is, it applies a TStore interface (API) to a UOS file. Here is the class definition:

const Err_UOS_Native_File_Store_Facility = 143 ;
      Err_Write_Only = 1 ;
      Err_Read_Only = 2 ;

type TUOS_Native_File_Store = class( TCOM_Store64 )
                                  public // Instance data...
                                      __File : TUOS_File ;

                                      _Cache : TCOM_Cache64 ;
                                      _Read_Only : boolean ;
                                      _Write_Only : boolean ;
                                      _Resolution : longint ;
                                      _Fixed : boolean ;

                                      _Bytes_Read : longint ;
                                      _Bytes_Written : longint ;
                                      _Reads : longint ;
                                      _Writes : longint ;
                                      _Error_Count : longint ;

                                  public // API...
                                      function Read_Data( var Data ; Address, _Size : TStore_Address64 ;
                                          var UEC : TUnified_Exception ) : TStore_Address64 ;
                                          override ;

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

                                      function Max_Storage : TStore_Size64 ;
                                          override ;

                                      function Min_Storage : TStore_Address64 ;
                                          override ;

                                      function Extend( Amount : TStore_Address64 ) : TStore_Address64 ;
                                          override ;

                                      function Get_Read_Only : boolean ;
                                          override ;

                                      function Get_Write_Only : boolean ;
                                          override ;

                                      procedure Format ; override ;

                                      function Get_Name : PChar ;
                                          override ;

                                      function Get_Cache : TCOM_Cache64 ;
                                          override ;

                                      procedure Set_Cache( Value : TCOM_Cache64 ) ;
                                          override ;

                                      function Contiguous_Store : boolean ;
                                          override ;

                                      procedure Set_Max_Storage( Value : TStore_Address64 ;
                                          var Res : TUnified_Exception ) ;
                                          override ;

                                      function Extended_Size : TStore_Address64 ;
                                          override ;

                                      function Get_Bytes_Read : longint ;
                                          override ;
                                      function Get_Bytes_Written : longint ;
                                          override ;
                                      function Get_Reads : longint ;
                                          override ;
                                      function Get_Writes : longint ;
                                          override ;
                                      function Get_Error_Count : longint ;
                                          override ;
                                      procedure Set_Bytes_Read( Value : longint ) ;
                                          override ;
                                      procedure Set_Bytes_Written( Value : longint ) ;
                                          override ;
                                      procedure Set_Reads( Value : longint ) ;
                                          override ;
                                      procedure Set_Writes( Value : longint ) ;
                                          override ;
                                      procedure Set_Error_Count( Value : longint ) ;
                                          override ;
                                      procedure Set_Read_Only( Value : boolean ) ;
                                          override ;
                                      procedure Set_Write_Only( Value : boolean ) ;
                                          override ;
                                      function Get_File : TUOS_File ;
                                          virtual ;
                                      procedure Set_File( Value : TUOS_File ) ;
                                          virtual ;

                                  published
                                      property _File : TUOS_File
                                          read Get_File
                                          write Set_File ;
                                      property Resolution : longint
                                          read _Resolution
                                          write _Resolution ;
                              end ; // TUOS_Native_File_Store

Resolution is the clustersize for this file store (the minimum allocation). _File is the UOS file that serves as the store. _Fixed is a flag that indicates that the store is a fixed size (cannot be resized). Fixed file stores are used as virtual disks when running UOS virtualized. We will discuss that in a future article.

First, here's the getters and setters for the statistics:

function TUOS_Native_File_Store.Get_Bytes_Read : longint ;

begin
    Result := _Bytes_Read ;
end ;


function TUOS_Native_File_Store.Get_Bytes_Written : longint ;

begin
    Result := _Bytes_Written ;
end ;


function TUOS_Native_File_Store.Get_Reads : longint ;

begin
    Result := _Reads ;
end ;


function TUOS_Native_File_Store.Get_Writes : longint ;

begin
    Result := _Writes ;
end ;


function TUOS_Native_File_Store.Get_Error_Count : longint ;

begin
    Result := _Error_Count ;
end ;


procedure TUOS_Native_File_Store.Set_Bytes_Read( Value : longint ) ;

begin
    _Bytes_Read := Value ;
end ;


procedure TUOS_Native_File_Store.Set_Bytes_Written( Value : longint ) ;

begin
    _Bytes_Written := Value ;
end ;


procedure TUOS_Native_File_Store.Set_Reads( Value : longint ) ;

begin
    _Reads := Value ;
end ;


procedure TUOS_Native_File_Store.Set_Writes( Value : longint ) ;

begin
    _Writes := Value ;
end ;


procedure TUOS_Native_File_Store.Set_Error_Count( Value : longint ) ;

begin
    _Error_Count := Value ;
end ;


procedure TUOS_Native_File_Store.Set_Read_Only( Value : boolean ) ;

begin
    _Read_Only := True ;
end ;


procedure TUOS_Native_File_Store.Set_Write_Only( Value : boolean ) ;

begin
    _Write_Only := True ;
end ;

And other getters/setters:

function TUOS_Native_File_Store.Get_Cache : TCOM_Cache64 ;

begin
    Result := _Cache ;
end ;


procedure TUOS_Native_File_Store.Set_Cache( Value : TCOM_Cache64 ) ;

begin
    if( Value <> nil ) then
    begin
        Value.Attach ;
    end ;
    if( _Cache <> nil ) then
    begin
        _Cache.Detach ;
    end ;
    _Cache := Value ;
end ;


function TUOS_Native_File_Store.Get_File : TUOS_File ;

begin
    Result := __File ;
end ;


procedure TUOS_Native_File_Store.Set_File( Value : TUOS_File ) ;

begin
    if( Value <> nil ) then
    begin
        Value.Attach ;
    end ;
    if( _File <> nil ) then
    begin
        _File.Detach ;
    end ;
    __File := Value ;
end ;

The cache and file getter and setter methods are typical for these kinds of properties.

Storage informational methods:

function TUOS_Native_File_Store.Max_Storage : TStore_Size64 ;

begin
    Result := _File.File_Size ;
end ;


function TUOS_Native_File_Store.Min_Storage : TStore_Address64 ;

begin
    Result := _Resolution ;
end ;

For Max_Storage, we return the file size, and for Min_Storage we return the Resolution.

And now we come to the methods which do most of the actual work:

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

var Original_Size : int64 ;

begin
    if( Amount = 0 ) then // Check for extendability
    begin
        if( Read_Only or _Fixed ) then
        begin
            Result := -1 ; // Cannot extend
        end else
        begin
            Result := 0 ; // Can extend
        end ;
        exit ;
    end ;
    if( Read_Only or _Fixed ) then
    begin
        Result := 0 ;
        exit ;
    end ;

    // Do the extend operation...
    Original_Size := _File.File_Size ;
    _File.File_Size := Original_Size + Amount ;
    Result := _File.File_Size - Original_Size ; // Amount actually extended
end ;


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

begin
    if( Write_Only ) then
    begin
        Result := 0 ;
        UEC := Create_Simple_UE( Err_UOS_Native_File_Store_Facility, 10, Err_Write_Only, UE_Error,
            'File is write-only', '' ) ;
        exit ;
    end ;
    Result := _File.Read( 0, Address, _Size, Data ) ;
    UEC := _File.Last_Error ;
end ;


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

var P : int64 ;

begin
    if( Read_Only ) then
    begin
        Result := 0 ;
        UEC := Create_Simple_UE( Err_UOS_Native_File_Store_Facility, 10, Err_Read_Only, UE_Error,
            'File is read-only', '' ) ;
        exit ;
    end ;
    P := Address - _File.File_Size ;
    if( P > 0 ) then
    begin
        while( P > 0 ) do
        begin
            if( P >= sizeof( P ) ) then
            begin
                P := P - sizeof( P ) ;
                _File.Write( 0, _File.File_Size, sizeof( P ), P )
            end else
            begin
                _File.Write( 0, _File.File_Size, P, P ) ;
                P := 0 ;
            end ;
        end ;
    end ;
    Result := _File.Write( 0, Address, _Size, Data ) ;
    UEC := _File.Last_Error ;
end ;

The Extend method is used both to interrogate the store's ability to expand, and to do the actual expansion. If the Amount passed is 0, it is an interrogation. If the store is read-only or fixed, we return -1 (indicating non-extendable store), otherwise we return 0. If the size is non-zero, it is a request to extend the store. We save the original size, attempt to set the file size to the current size plus the amount of extension requested. We then return the actual amount extended by subtracting the original size from the current size (which may result in 0 if the operation failed). If the store is read-only or fixed, we return 0 to indicate that the operation failed.

The Read_Data method is simple. If we are write-only, we return an error. Otherwise, we simply pass the request on to the file. Likewise, the Write_Data method is easy. If the file is read-only, we return an error. If, for some reason, the starting offset of the write is past the physical end of the file, we append nuls to the file until its length is equal to Address. Once the file is at least Address bytes long, we pass the write operation to the file.

And finally, a smattering of other support methods:

function TUOS_Native_File_Store.Contiguous_Store : boolean ;

begin
    Result := True ;
end ;


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

begin
    if( Read_Only ) then
    begin
        Res := Create_Simple_UE( Err_UOS_Native_File_Store_Facility, 10, Err_Read_Only, UE_Error,
            'File is read-only', '' ) ;
        exit ;
    end ;
    _File.Set_Stream_Size( 0, Value ) ;
    Res := _File.Last_Error ;
end ;


function TUOS_Native_File_Store.Extended_Size : TStore_Address64 ;

begin
    Result := Max_Storage ;
    if( not Read_Only ) then
    begin
        Result := Result + _File.XSpaceAvail ;
    end ;
end ;


procedure TUOS_Native_File_Store.Format ;

begin
    // This does nothing
end ;


function TUOS_Native_File_Store.Get_Name : PChar ;

begin
    Result := nil ;
end ;


function TUOS_Native_File_Store.Get_Read_Only : boolean ;

begin
    Result := _Read_Only or _File.Read_Only ;
end ;


function TUOS_Native_File_Store.Get_Write_Only : boolean ;

begin
    Result := _Write_Only or _File.Write_Only ;
end ;

From the standpoint of a file, the store is contiguous, so we return true for the Contiguous_Store call. A request to set the max store size only succeeds if the file store isn't set to read-only. If not, we simply set the size of the data stream to the requested size. The call to Extended_Size returns the maximum potential store size, which is the current file size plus the space available on the store (returned by XSpaceAvail). File stores have no inherent internal format (such as the low-level formatting on a disk), so the Format method does nothing. The Get_Name function returns nil, indicating no name. Conceivably, this could return the name of the file, but there is little reason to do this. Get_Read_Only returns true if the file is read-only, or if the internal flag has been set to logically set the file store to read-only. Likewise, the Get_Write_Only method returns true if the file is set to write-only or if the write-only internal flag has been set to logically read-lock the file store.

File Heaps
The foregoing provides almost everything we need to implement the SYSUAF.DAT file. However, there are some general needs for a file heap due to the fact that it can be read by a system that didn't create the file in conjunction with the customizable clustersize. In other words, we need a means of storing some meta data about the file heap in addition to the file heap itself. Such meta data could be stored in one of the file's streams, but for the purposes of file heaps, we will store this information within the file ifself. This makes file heaps easily transportable across different file systems.

type TFH_Header = packed record
                      Prefix : byte ;
                      Facility : byte ;
                      Version : byte ;
                      Reservedb : byte ;
                      Resolution : longint ;
                      Flags : longint ;
                      Reserved : longint ;
                      AT_Offset : int64 ;
                      Origin : int64 ;
                  end ;

As mentioned above, the file heap has a header structure embedded in it for meta data. The Prefix and Facility values indicate that this is a file heap. The version indicates the version of the data structures used within this file (in other words, the header). The file heap code can be changed or replaced, but so long as the data structure(s) within the file remain unchanged, the version number will remain unchanged. The version is a number indicating the major and minor version number. Thus, a value of 11 means major version 1, minor version 1 (or V1.1) - essentially divide the number by 10. That limits us to a maximum version of 25.5, but that should be sufficient for our purposes. Note that a difference in minor version (say, from n.1 to n.2) indicates that the data structure is unchanged, but may support additional flags and/or used some previously reserved data. Since an earlier version doesn't look for the new flags or used reserved data, the data structure is still compatible with older code. But if the layout, or meaning, changes, that indicates a new major version and older code cannot properly make use of it. The resolution indicates the clustersize of the file heap, in bytes. Flags is a collection of bit flags. AT_Offset is important because it indicates where the allocation table is located in the file. Without this, we couldn't use a previously-created file heap since we don't know where to load the allocation table from. Origin is a location that the calling code can get and set. It is used to indicate where the root data structures are that are used in the file heap. Without this, there is no way to find the data that the code which uses the file heap class has placed in the heap. The reserved items are reserved for future use.
The header is always stored at the beginning of the file (offset 0), but this is internal to the file heap class and the user has no visibility of it (other than the Origin value). The initial allocation table is stored immediately following the header. If the file heap is extended, this may be moved to another location in the file, hence our need to store its current location in the header. Of course, all of this is implementation detail that is unknown outside of the file heap class. Even though we do know the implementation, the fact is that it can change in a later version, so all code that uses a file heap has to at least pretend that we know nothing about the file heap implementation. To do otherwise is to introduce pathological coupling, which will eventually break code.

Here is the class definition:

type TUOS_File_Heap = class( TUOS_Managed_Store )
                          public // Constructors and destructors...
                              constructor Create ;
                              destructor Destroy ; override ;

                          private // Instance data...
                              ATO_File_Position : int64 ; // Location of AT offset pointer in the file
                              _File_Store : TUOS_Native_File_Store ;
                              _Name : string ;
                              _Resolution : longint ;

                          protected // Internal utility routines...
                              function Valid_Range( Root, Length : int64 ) : boolean ;
                              function Get_Length( Root : int64 ) : int64 ;
                              function Init_Heap : TUnified_Exception ;
                              function Round_Up( S, Resolution : longint ) : longint ;

                          protected // Property handlers...
                              function Get_Resolution : longint ;
                              procedure Set_Resolution( Value : longint ) ;
                              function Get_File : TUOS_File ;
                              procedure Set_File( Value : TUOS_File ) ;
                              function Get_Origin : int64 ;
                              procedure Set_Origin( Value : int64 ) ;

                          public { Overrides... }
                              function Is_Class( Name : PChar ) : boolean ;
                                  override ;

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

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

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

                              procedure Set_Max_Storage( Value : TStore_Address64 ;
                                  var Res : TUnified_Exception ) ;
                                  override ;

                              function Allocate( Size : TStore_Address64 ) :
                                  TStore_Address64 ; override ;
                                  { Allocate space}
                              function Allocate_At( Offset,
                                  Size : TStore_Address64 ) : boolean ;
                                  override ;
                                  { Allocate space at specific location }
                              procedure Copy( Source,
                                  Destination : TStore_Address64 ;
                                  Count : int64 ) ; override ; { Copy data }
                              procedure Deallocate( PTR,
                                  Size : TStore_Address64 ) ;
                                  override ;
                              procedure Fill( PTR : TStore_Address64 ;
                                  Count : integer ; Value : byte ) ;
                                  override ;
                              function Min_Storage : TStore_Address64 ;
                                  override ;
                              function Reallocate( PTR, Old,
                                  New : TStore_Address64 ) : TStore_Address64 ;
                                  override ;

                          public // API...
                              function Open( FS : TUOS_File_System ;
                                  Name : string ) : TUnified_Exception ;
                                  virtual ;
                              function Getmem( Size : int64 ) : int64 ; virtual ;
                              procedure freemem( PTR : int64 ) ; virtual ;
                              function Reallocmem( PTR, Size : int64 ) : int64 ;
                                  virtual ;

                          public // Properties...
                              property _File : TUOS_File
                                  read Get_File
                                  write Set_File ;
                              property Origin : int64
                                 read Get_Origin
                                 write Set_Origin ;
                              property Resolution : longint
                                  read Get_Resolution
                                  write Set_Resolution ;
                      end ; { TUOS_File_Heap }

const Err_UOS_File_Heap_Facility = 144 ;
const Err_Illegal_Call = 1 ;
const Err_Access_Error = 2 ;
const Err_Invalid_Heap_File = 3 ;
const Err_Incompatible_Version = 4 ;

TUOS_File_Heap class is a descendent of TUOS_Managed_Store. You may wonder, if the file heap is a descendent class of the UOS Managed Store then why did we modify TUOS_Managed_Store to handle extendable stores rather than just include that code in an override of the Allocate method? The reason is because there are other types of stores that could be extended and we wanted to support them in a general way.

// Constructors and destructors...

constructor TUOS_File_Heap.Create ;

begin
    inherited Create ;

    _Resolution := 16 ;
end ;


destructor TUOS_File_Heap.Destroy ;

begin
    if( _File_Store <> nil ) then
    begin
        _File_Store.Detach ;
        _File_Store := nil ;
    end ;

    inherited Destroy ;
end ;


// Internal utility routines...

function TUOS_File_Heap.Valid_Range( Root, Length : int64 ) : boolean ;

begin
    Result := ( not ( 
                    ( Root < Allocation_Table_Offset + AT.Size ) 
                    and 
                    ( Root + Length >= Allocation_Table_Offset )
                   ) ) // AT
              and
              ( not ( Root < Resolution ) ) ; // Cluster 0
end ;


function TUOS_File_Heap.Get_Length( Root : int64 ) : int64 ;

var UEC : TUnified_Exception ;

begin
    inherited Read_Data( Result, Root - sizeof( int64 ), sizeof( int64 ), UEC ) ;
end ;

The constructor defaults the file heap resolution to 16 bytes. This is a good compromise between reducing the allocation table overhead and wasting space in the file. In the destructor, we detach from the file store, if it is non-null. The Valid_Range function does a simple validation of addresses to prevent corruption of the internal heap structures (the allocation table and the header). Bugs in calling code might corrupt whatever other structures are in the file heap, but they won't destroy the integrity of the file heap itself.
We use a similar heap implementation as we did with the HMC component - each allocation is prefixed with a length value. Since UOS files can be up to 2⁶⁴ bytes in length, any pointer or segment size for the file heap must be able to contain a 64-bit value. The Get_Length function will take an address from a caller and return the length prefix.

function TUOS_File_Heap.Get_Resolution : longint ;

begin
    Result := _Resolution ;
end ;


procedure TUOS_File_Heap.Set_Resolution( Value : longint ) ;

var I : longint ;

begin
    I := 16 ; // Minimum resolution
    while( I > 0 ) do
    begin
        if( I = Value ) then
        begin
            _Resolution := I ;
            _File_Store._Resolution := I ;
            exit ;
        end ;
        I := I + I ;
    end ;
end ;


function TUOS_File_Heap.Get_File : TUOS_File ;

begin
    Result := _File_Store._File ;
end ;


function TUOS_File_Heap.Round_Up( S, Resolution : longint ) : longint ;

begin
    Result := ( S + Resolution - 1 ) and not ( Resolution - 1 ) ;
end ;


procedure TUOS_File_Heap.Set_File( Value : TUOS_File ) ;

var I : integer ;
    ATO : int64 ;
    ATS : longint ;

begin
    if( _File_Store = nil ) then
    begin
        _File_Store := TUOS_Native_File_Store.Create ;
        _File_Store.Attach ;
        _File_Store.Resolution := 16 ;
    end ;
    _File_Store._File := Value ;
    Store := _File_Store ;
    if( Value <> nil ) then
    begin
        Init_Heap ;
    end ; // if( Value <> nil )
end ; // TUOS_File_Heap.Set_File

Set_Resolution allows the caller to change the file heap's resolution. The method defaults to 16, and ensures that the resolution is a power of 2. Round_Up rounds a length up to a full cluster in length. Obviously, this call should be made before assigning a file to the object, otherwise the resolution value may not match how things are aligned in the file.

Get_File is a getter for the _File property. And Round_Up is used to round a value to a cluster boundary, based on our set Resolution.

The Set_File property handler creates a file store object if one has not yet been created (defaulting the resolution to 16). In either case, the file stores's file is assigned the passed value. If it is non-nil, the Init_Heap method is called to set up the heap.

function TUOS_File_Heap.Get_Origin : int64 ;

var FH_Header : TFH_Header ;

begin
    Set_Last_Error( nil ) ;
    Result := 0 ;
    if( _File_Store._File.File_Size < sizeof( FH_Header ) ) then // File is smaller than the file header
    begin
        Set_Last_Error( Create_Simple_UE( Err_UOS_File_Heap_Facility, 10, Err_Invalid_Heap_File, UE_Error, 
            'Invalid heap file', '' ) ) ; // Not a file heap file
        exit ;
    end ;
    _File_Store._File.Read( 0, 0, sizeof( FH_Header ), FH_Header ) ;
    Set_Last_Error( _File_Store._File.Last_Error ) ;
    if( Last_Error <> nil ) then
    begin
        exit ;
    end ;
    Result := FH_Header.Origin ;
end ;


procedure TUOS_File_Heap.Set_Origin( Value : int64 ) ;

var FH_Header : TFH_Header ;

begin
    Set_Last_Error( nil ) ;
    if( _File_Store._File.File_Size < sizeof( FH_Header ) ) then // File is smaller than the file header
    begin
        Set_Last_Error( Create_Simple_UE( Err_UOS_File_Heap_Facility, 10, Err_Invalid_Heap_File, UE_Error, 
            'Invalid heap file', '' ) ) ; // Not a file heap file
        exit ;
    end ;
    _File_Store._File.Read( 0, 0, sizeof( FH_Header ), FH_Header ) ;
    Set_Last_Error( _File_Store._File.Last_Error ) ;
    if( Last_Error <> nil ) then
    begin
        exit ;
    end ;
    FH_Header.Origin := Value ;
    _File_Store._File.Write( 0, 0, sizeof( FH_Header ), FH_Header ) ;
    Set_Last_Error( _File_Store._File.Last_Error ) ;
end ;

As we discussed above, the Origin value is used to store/retrieve a value defined by the code that uses the file heap. These getter/setter functions simply access that value in the file heap header.

Here are the override methods:

function TUOS_File_Heap.Is_Class( Name : PChar ) : boolean ;

begin
    Result := lowercase( Name ) = 'tuos_file_heap' ;
    if( not Result ) then
    begin
        Result := inherited Is_Class( Name ) ;
    end ;
end ;


function TUOS_File_Heap.Get_Name : PChar ;

begin
    Result := PChar( _Name ) ;
end ;


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

begin
end ;


function TUOS_File_Heap.Allocate( Size : TStore_Address64 ) : TStore_Address64 ;

begin
    Result := 0 ; // Use getmem
end ;


function TUOS_File_Heap.Allocate_At( Offset, Size : TStore_Address64 ) : boolean ;

begin
    Result := False ; // use getmem
end ;


procedure TUOS_File_Heap.Copy( Source, Destination : TStore_Address64 ;
    Count : int64 ) ;

begin
    if( not Valid_Range( Source, Count ) ) then
    begin
        exit ; // Err_Access_Error
    end ;
    if( not Valid_Range( Destination, Count ) ) then
    begin
        exit ; // Err_Access_Error
    end ;
    inherited Copy( Source, Destination, Count ) ;
end ;


procedure TUOS_File_Heap.Deallocate( PTR, Size : TStore_Address64 ) ;

begin
    // Use Deallocmem
end ;


procedure TUOS_File_Heap.Fill( PTR : TStore_Address64 ;
    Count : integer ; Value : byte ) ;

begin
    if( not Valid_Range( PTR, Count ) ) then
    begin
        exit ; // Err_Access_Error
    end ;
    inherited Fill( PTR, Count, Value ) ;
end ;


function TUOS_File_Heap.Min_Storage : TStore_Address64 ;

begin
    Result := Resolution ;
end ;


function TUOS_File_Heap.Reallocate( PTR, Old, New : TStore_Address64 ) : TStore_Address64 ;

begin
    Result := 0 ; // Use reallocmem
end ;

These methods handle the basic store operations. Note that the Allocate, Allocate_At, and Deallocate don't do anything. This forces these operations through the heap-specific methods. The Copy and Fill methods first validate the passed addresses and then call the inherited class' methods.

The Init_Heap method performs one of two functions. If the file is zero-length, a new structure is written to the file. Otherwise, we validate that the file contains a valid structure and then loca the allocation table and resolution value.

function TUOS_File_Heap.Init_Heap : TUnified_Exception ;

var FH_Header : TFH_Header ;
    I : int64 ; // AT Size
    S : int64 ; // New file size

begin
    // Initialize data...
    Result := nil ;
    Set_Last_Error( nil ) ; // Clear errors

    if( _File_Store._File.File_Size = 0 ) then
    begin
        // Initialize new heap...
        fillchar( FH_Header, sizeof( FH_Header ), 0 ) ;
        FH_Header.Prefix := $FF ;
        FH_Header.Facility := Err_UOS_File_Heap_Facility ;
        FH_Header.Resolution := Resolution ;
        _File_Store._File.Write( 0, 0, sizeof( FH_Header ), FH_Header ) ;
        Allocation_Table_Offset := Round_Up( sizeof( FH_Header ), Resolution ) ;
        AT.Offset := Allocation_Table_Offset ;
        AT.Store := _File_Store ;
        AT.Size := ( _File_Store._File.File_Size div Resolution + 7 ) div 8 ;
        AT.Resolution := Resolution ;
        AT.Allocate( Allocation_Table_Offset + Resolution ) ; // Mark header and AT as allocated
        AT.Flush ;
        exit ;
    end ;

The function starts by clearing exceptions. Then we check for a zero-length file. If it is zero-length, we initialize the header to the proper values and then write the header. Then we set up the allocation table. The offset for the AT is the address immediately following the cluster(s) that hold the header. Then we allocate the header and AT clusters and flush the AT to the file. At this point, we are done and exit. But if the file is non-zero, we proceed to the following checks:

    // Read the file header...
    if( _File_Store._File.File_Size < sizeof( FH_Header ) ) then // File is smaller than the file header
    begin
        Result := Create_Simple_UE( Err_UOS_File_Heap_Facility, 10, Err_Invalid_Heap_File, UE_Error, 
            'Invalid heap file', '' ) ; // Not a file heap file
        Set_Last_Error( Result ) ;
        exit ;
    end ;
    _File_Store._File.Read( 0, 0, sizeof( FH_Header ), FH_Header ) ;
    if(
        ( FH_Header.Prefix <> $FF )
        or
        ( FH_Header.Facility <> Err_UOS_File_Heap_Facility )
      ) then
    begin
        Result := Create_Simple_UE( Err_UOS_File_Heap_Facility, 10, Err_Invalid_Heap_File, UE_Error, 
            'Invalid heap file', '' ) ; // Not a file heap file
        Set_Last_Error( Result ) ;
        exit ;
    end ;
    if( FH_Header.Version >= 1 ) then // We only understand file versions < V1.0
    begin
        Result := Create_Simple_UE( Err_UOS_File_Heap_Facility, 10, Err_Incompatible_Version, UE_Error, 
             'Invalid heap file', '' ) ;
        Set_Last_Error( Result ) ;
        exit ;
    end ;
    if( ( FH_Header.Resolution < 2 ) or not Power_Of_2( FH_Header.Resolution ) ) then
    begin
        Result := Create_Simple_UE( Err_UOS_File_Heap_Facility, 10, Err_Invalid_Heap_File, UE_Error, 
            'Invalid heap file', '' ) ; // Not a file heap file
        Set_Last_Error( Result ) ;
        exit ;
    end ;
    if(
        ( ( FH_Header.AT_Offset and ( FH_Header.Resolution - 1 ) ) <> 0 ) // AT not aligned on cluster
        or
        ( FH_Header.AT_Offset + FH_Header.Resolution > _File_Store._File.File_Size ) // AT beyond EOF
        or
        ( FH_Header.AT_Offset < S + FH_Header.Resolution ) // AT before the headers
      ) then
    begin
        Result := Create_Simple_UE( Err_UOS_File_Heap_Facility, 10, Err_Invalid_Heap_File, UE_Error, 
            'Invalid heap file', '' ) ; // Not a file heap file
        Set_Last_Error( Result ) ;
        exit ;
    end ;

These checks ensure that the file heap structure is valid. If any of these fail, it indicates that the file is either a corrupted heap or a non-heap. The first check is that the file is large enough to contain at least the header. If we pass that check, we read the header into memory from the store. The next check validates the prefix and facility codes. The next one ensures that the version is within the range of versions that we understand. Note that if the version is out of range it could mean either that the file is not a file heap at all, or it is a future version. Next, we validate the resolution, which must be a power of 2 that is a minimum value of 2. The final check makes sure that the AT offset is on a cluster boundary, not mapped over the header, and not beyond the end of the file. If any of these conditions fail, we return an exception.

    // Load the AT...
    Resolution := FH_Header.Resolution ;
    S := _File_Store._File.File_Size div Resolution ; // Number of clusters in file
    I := ( S + 7 ) div 8 ; // Number of bytes needed to represent the clusters
    Allocation_Table_Offset := FH_Header.AT_Offset ;
    AT.Store := _File_Store ;
    AT.Size := I ;
    AT.Resolution := Resolution ;
    AT.Load_Table ;
    Set_Last_Error( AT.Last_Error ) ;
end ; // TUOS_File_Heap.Init_Heap

If we make it to this code, we have a valid pre-existing file heap. So we calculate the size of the allocation table and then load it from the file.

function TUOS_File_Heap.Open( FS : TUOS_File_System ;
    Name : string ) : TUnified_Exception ;

var Fil : TUOS_File ;

begin
    Fil := FS.Get_File( pchar( Name ) ) ;
    if( Fil = nil ) then
    begin
        Result := FS.Last_Error ;
        exit ;
    end ;
    _Name := Name ;
    Result := nil ;
    Set_File( Fil ) ;
end ;

This method is the second way to assign a file to the file store. It takes a file system and a name and opens the named file on the file system. Then it assigns the file via Set_File (which is the first method to assign a file).

function TUOS_File_Heap.Getmem( Size : int64 ) : int64 ;

var ATO : int64 ;

begin
    ATO := Allocation_Table_Offset ;
    Size := Size + sizeof( int64 ) ; // Include space for size prefix
    Size := Round_Up( Size, Resolution ) ; // Round up
    Result := inherited Allocate( Size ) ;
    if( Result <> 0 ) then
    begin
        _File.Write( 0, Result, sizeof( int64 ), Size ) ;
        Result := Result + sizeof( int64 ) ; // Point to the data just past the prefix
    end ;
    if( ATO <> Allocation_Table_Offset ) then // File was resized
    begin
        ATO := Allocation_Table_Offset ;
        _File.Write( 0, ATO_File_Position, sizeof( ATO ), ATO ) ;
    end ;
end ;

Getmem is the allocation method used in the file heap rather than the Allocate method. It adds the size of the prefix to the requested amount, rounds up to a full cluster, calls the inherited Allocate and, if successful, writes the size prefix. Since the UOS Managed Store's Allocate routine may resize the heap (and allocation table), we save the allocation table offset at the start of the function and then compare it with the offset after the allocation. If it has changed, then the AT was moved, so we write the new AT offset to the header.

procedure TUOS_File_Heap.Freemem( PTR : int64 ) ;

var L : longint ;

begin
    if( not Valid_Range( PTR, L ) ) then
    begin
        exit ; // Err_Access_Error
    end ;
    L := Get_Length( PTR ) ;
    inherited Deallocate( PTR - sizeof( int64 ), L ) ;
end ;

Instead of Deallocate, the file heap uses Freemem to deallocate. First it verifies the address, then gets the length of the segment, and calls the inherited deallocate.

function TUOS_File_Heap.Reallocmem( PTR, Size : int64 ) : int64 ;

var ATO : int64 ;
    L : longint ;

begin
    ATO := Allocation_Table_Offset ;
    if( not Valid_Range( PTR, L ) ) then
    begin
        Result := 0 ;
        exit ; // Err_Access_Error
    end ;
    L := Get_Length( PTR ) ;
    Size := Size + sizeof( int64 ) ; // Include space for size prefix
    Size := ( Size + Resolution - 1 ) and not ( Resolution - 1 ) ; // Round up
    Result := inherited Reallocate( PTR - sizeof( int64 ), L, Size ) ;
    if( ATO <> Allocation_Table_Offset ) then // File was resized
    begin
        ATO := Allocation_Table_Offset ;
        _File.Write( 0, ATO_File_Position, sizeof( ATO ), ATO ) ;
    end ;
end ;

Instead of Reallocate, the file heap uses Reallocmem. First we validate the passed address, then we get the length prefix and call the inherited reallocate. Finally we check for a changed AT offset, as we did in the Getmem method.

And finally, the read and write methods:

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

begin
    Result := 0 ;
    if( not Valid_Range( Address, _Size ) ) then
    begin
        UEC := Create_Simple_UE( Err_UOS_File_Heap_Facility, 10, Err_Illegal_Call, UE_Error, 
            'Illegal call', '' ) ;
        exit ;
    end ;
    Result := inherited Read_Data( Data, Address, _Size, UEC ) ;
end ;


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

begin
    Result := 0 ;
    if( not Valid_Range( Address, _Size ) ) then
    begin
        UEC := Create_Simple_UE( Err_UOS_File_Heap_Facility, 10, Err_Illegal_Call, UE_Error, 
            'Illegal call', '' ) ;
        exit ;
    end ;
    Result := inherited Write_Data( Data, Address, _Size, UEC ) ;
end ;

The Read_Data and Write_Data simply validate the passed address and then call the inherited version.

With these two new classes, and the modifications to TUOS_Managed_Store, UOS now has the ability for file stores and file heaps.
In the next article, we will look at some support classes that will make use of a File Heap much easier for the purposes of the SYSUAF.DAT file (and others that we will address in the future).