Twisting Pool Allocator (Scopes)

twistpool.sc

""""Twisting Pool Allocator
    =======================
    written by Leonard Ritter (leonard.ritter@duangle.com)

    ported and expanded from the C version (https://gist.github.com/paniq/d867c6b5ea9c68a352a1)

    This file is in the public domain

    I don't know if I was the first one to stumble upon this technique, so
    I can't guarantee there's no patent on it, but let's hope there's not, 
    then this counts as prior art.

    --------------------------------------------------------------------------------

    This is a proof of concept implementation for a pool allocator that guarantees
    compactness (unsorted gapless iteration without indirections) while preserving 
    element ids (using one order-optimized indirection), with insertion, deletion 
    and lookup in O(1) time.

    Because all id <-> index assignments are symmetric swaps (either 
    identity-mapped or twisted), only a single table is required to resolve 
    index from id and id from index.

    Insertion and deletion is a self-sorting process. Both operations attempt
    to untwist identifiers that share the same status (obtained/released) and
    so, regardless of deallocation order, only few entries are accessed and
    fragmentation is generally low; in my random allocation test, the average number
    of fragmented entries appeared to be ~log2(capacity)); It is possible to produce
    a worst case by obtaining all id's, then releasing every other id. The upper
    bound on fragmented entries appears to be capacity/3.

    The data being managed must be allocated separately, and the user must
    copy at least none, at most one element after a call to obtain/release.

    With this implementation, the memory requirement is 
    sizeof(unsigned int) * capacity, typically 4 bytes per entry.

    It might however possible to implement the map with a compact sorted array or
    hashtable, storing only twisted entries, which should tremendously reduce memory
    usage and therefore notably improve cache efficiency.

    --------------------------------------------------------------------------------

using import ..tukan.random

#   use whatever size you prefer; this implementation operates directly on 
    global memory; a productive implementation would probably use the heap.
let CAPACITY = 10000:u32
let N = (CAPACITY + 1:u32)

#   index: offset of element in data array; elements are moved
    to keep the array compact and contiguous

    id: numerical name assigned to a data element; never changes.
    therefore, elements should typically be referenced by their id,
    not their index.

    id 0 and index 0 are synonymous with no element
    
#   symmetrical map
    maps index -> id; compact, gapless
    last index == count
    happens to also map id -> index; has gaps
global map : (array u32 N)

#   all ids are mapped, even the unused ones;
    the ideal mapping is id == index
    the first free index is count+1
    if count == capacity, the pool is full.
global count : u32

# pool constructor
fn construct ()
    # initially no elements
    count = 0
    for i in (range N)
        # start out with identity mapping;
        # all unused ids are mapped
        map @ i = i

# lookup index from id or id from index
inline resolve (id_or_index)
    deref (map @ id_or_index)

inline is_index_valid (index)
    (index > 0) & (index <= count)

inline is_id_valid (id)
    ((id > 0) & (id <= CAPACITY)) and (is_index_valid (resolve id))

inline is_identity (id_or_index)
    (resolve id_or_index) == id_or_index

# swap the ids of two indices (or the indices of two ids)
fn swap (a b)
    # ids can only be twisted or untwisted, map must not be shuffled any further
    assert ((a == b)
            | (((resolve a) == a) & ((resolve b) == b))
            | (((resolve a) == b) & ((resolve b) == a)))
    let t = (resolve a)
    map @ a = map @ b
    map @ b = t
    ;

#   allocate a new id from the pool
    user must copy slot[index(id)] to slot[count] after
    allocation. obtain() returns a { src, dst } tuple indicating
    how data must be moved; if (dst == src), then no move is necessary.
    src is also identical to the newly obtained id
    if the pool is full, obtain returns { 0, 0 }
fn obtain ()
    if (count < CAPACITY)
        # increase number of elements
        count += 1
        # index of new last element
        let index = (deref count)
        # id of new last element
        let id = (resolve index)
        # if id not identical to index (is twisted)
        if (id != index)
            # swap with index that matches this id,
            # so that index(id) == id
            swap index id
        # return new id/index and index of moved item
        return id index
    else
        # out of space
        return 0:u32 0:u32

#   release an obtained id to the pool
    user must copy slot[count] to slot[index(id)] after
    deletion. (release id) returns a (src dst) tuple indicating
    how data must be moved; if (src == dst), then no move is necessary.
fn release (id)
    assert (is_id_valid id)
    
    # index of element to be deleted
    let index = (resolve id)
    
    # if element is twisted, then untwist
    if (id > count)
        swap index id
    # index and id of element to take its place
    let last_index = (deref count)
    let last_id = (resolve last_index)
    
    # swap indices so that tailing element fills the gap (twist)
    # if last element is twisted, then untwist first
    if (last_id > count)
        swap last_index last_id
        swap index last_id
    else
        swap index last_index
        
    # decrease number of elements
    count -= 1
    # return index of element to be moved and index of gap
    return last_index index

# ----------------------------------------------------------------------------
# test

include "stdio.h"
    filter "^(printf)$"

# our "data array", which just stores the id again, so we can easily verify
# if an id still matches its assigned content
global data : (array u32 N)

fn dump_map ()
    printf "index -> ID:\n"
    let end = (count + 1:u32)
    for i in (range 1:u32 (CAPACITY + 1:u32))
        if (i == end)
            printf "-------\n"
        let id = (resolve i)
        let ri = (resolve id)
        printf "%u\t%u\t%s\n" i id (? (i != ri) "!" "")
    printf "%i used elements\n\n" (deref count)
 
fn move_entry (k0 k1)
    if (k0 != k1)
        data @ k1 = data @ k0

fn verify_data ()
    local twisted = 0:u32
    for i in (range 1:u32 (count + 1:u32))
        let id = (resolve i)
        assert (data @ i == id)
        assert ((resolve id) == i)
        if (not (is_identity i))
            twisted += 1:u32
    deref twisted

fn test_obtain ()
    let k0 k1 = (obtain)
    move_entry k0 k1
    data @ k0 = k0
    k0

fn test_release (id)
    assert (id != 0)
    let k0 k1 = (release id)
    move_entry k0 k1

# array of ids in use
global used : (array u32 N)

fn main ()
    local mintwisted : u32 = N
    local maxtwisted : u32 = 0
    local total : u32 = 0
    local steps : u32 = 0
    local used_count : u32 = 0
    
    for i in (range N)
        used @ i = 0
    
    construct;

    local rnd : (Random)

    static-if true
        # do random obtains/releases, see if something breaks
        for i in (range 100000)
            if ((('range rnd 0 100) < 50) & (used_count > 0))
                let used_index = ('range rnd 0:u32 used_count)
                let id = (deref (used @ used_index))
                # remove from used array and fill
                used_count -= 1
                used @ used_index = used @ used_count
                used @ used_count = 0
                test_release id            
                let t = (verify_data)
                mintwisted = (min mintwisted t)
                maxtwisted = (max maxtwisted t)
                total += t
                steps += 1
            else
                let k = (test_obtain)
                if (k != 0)
                    assert (used_count < CAPACITY)
                    used @ used_count = k
                    used_count += 1
                verify_data;
    else
        # attempt to fabricate a worst case
        for i in (range CAPACITY)
            test_obtain;
        for i in (range 1 (CAPACITY + 1) 2)
            test_release i
            let t = (verify_data)
            mintwisted = (min mintwisted t)
            maxtwisted = (max maxtwisted t)
            total += t
            steps += 1
    
    dump_map;
    printf "releases: %u\nmin twisted: %u\nmax twisted: %u\ntotal twisted: %u\naverage: %f\n"
        \ steps mintwisted maxtwisted total (total / steps)
    printf "OK.\n"
    ;

main;