rpalloc.sc

# note that with a custom heap implementation, these features can be supported
# without tagging.
# for more info, see
#   https://gist.github.com/paniq/429c96446e3e7e01f0c860987049d1cf

using import struct print format C.stdio

malloc := extern 'malloc (function voidstar usize)
realloc := extern 'realloc (function voidstar voidstar usize)
free := extern 'free (function void voidstar)

MIN_ALIGN := 16

struct Header plain
    start : voidstar
    size : usize
static-assert ((sizeof Header) == MIN_ALIGN)

# allocate sliceable allocation
fn... rpalloc (S : usize)
    # compute ceil(log2(S)); these are the number of bits required for
    # subaddressing.
    logC := (findmsb ((max S MIN_ALIGN) - 1)) + 1
    C := 1:u64 << logC
    C2 := C * 2
    # allocate twice the capacity to include an aligned address in the first
    # half.
    pp := malloc C2
    p := ptrtoint pp intptr

    # advance and align pointer by the offset header that we require; note that
    # due to MIN_ALIGN, there are always 8 extra bytes available anyway, which
    # we use to store S; the header could be extended further, e.g. to support
    # refcounting.
    q := p + (sizeof Header)
    q := (q + C - 1) & -C
    qb := q - (sizeof Header)
    FS := (q - p) + S       # final size of allocation; if we truncated to C
                            # instead, we would have all features satisfying
                            # the implementation of a dynamic array, at no extra
                            # cost.
    # reclaim the trailing space we don't need
    if (FS != C2)
        # note: realloc must preserve the address when truncating
        p2 := ptrtoint (realloc (inttoptr p voidstar) FS) intptr
        if (p2 != p)
            fprintf stderr "rpalloc: failed to truncate allocation.\n"
            exit -1
    # write real base address to header
    h := inttoptr qb (mutable @Header)
    h.start = pp
    h.size = S
    # tag top 8 bits of pointer (in practice we only need 6 bits)
    q := q | ((logC as intptr) << 56)
    return (inttoptr q (mutable voidstar))

# untag pointer
inline rpuntag (p)
    inttoptr ((ptrtoint p intptr) & 0xffffffffffffff:u64) (typeof p)

# get capacity from slice pointer
inline... rpcapacity (p : voidstar)
    q := ptrtoint p intptr
    1:u64 << (q >> 56)

# get header from slice pointer
inline... rpheader (p : voidstar)
    C := rpcapacity p
    q := ptrtoint p intptr
    # untag and offset backwards to header
    p := ((q & 0xffffffffffffff:u64) & -C) - (sizeof Header)
    inttoptr p @Header

# estimate overhead of allocation
inline... rpoverhead (p : voidstar)
    q := ptrtoint (rpuntag p) intptr
    bp := ptrtoint ((rpheader p) . start) intptr
    q - bp

# free sliceable allocation
fn... rpfree (p : voidstar)
    h := rpheader p
    free h.start

@if main-module?
do
    # testing
    using import Array
    local ps : (Array voidstar)
    for i in (range (1:u64 << 10))
        p := (rpalloc i)
        print
            /nolines i p (rpcapacity p) (rpoverhead p)
        'append ps p
    for p in ps
        rpfree p
@endif

;