Browse Source

Make chain-allocate support memory alignment

* Make it clear whether you are requesting aligned or unaligned
memory.
* Added helpful macro (chain-allocate-aligned-type) for easily
allocating aligned types.
* Fix error returns not freeing the right chain.
master
Macoy Madson 8 months ago
parent
commit
b8095d3dc4
  1. 171
      src/Allocator.cake

171
src/Allocator.cake

@ -5,6 +5,7 @@
(c-import "<stdlib.h>"
"<assert.h>"
"<stdint.h>" ;; uintptr_t
&with-decls "<stddef.h>")
(comptime-cond
@ -14,7 +15,7 @@
(defstruct block-allocation
size size_t
capacity size_t
data (* void))
data (* (unsigned char)))
(defun block-allocation-create (size size_t &return (* block-allocation))
;; Create the header alongside the block so it can all go away in one free
@ -24,7 +25,7 @@
(return null))
(set (path new-block > size) 0)
(set (path new-block > capacity) size)
(set (path new-block > data) (type-cast (+ new-block 1) (* void)))
(set (path new-block > data) (type-cast (+ new-block 1) (* (unsigned char))))
(return new-block))
(defun block-allocation-free (block (* block-allocation))
@ -34,6 +35,7 @@
;; Simple linear allocator based on a single block
;;
;; Unaligned!
(defun linear-allocate (block (* block-allocation) size size_t &return (* void))
(unless (and block (path block > data))
(allocate-failure "block allocation was not initialized")
@ -43,7 +45,7 @@
(allocate-failure "failed to allocate: not enough capacity for requested size")
(return null))
(var-cast-to start (* void) (+ (type-cast (path block > data) (* char)) (path block > size)))
(var-cast-to start (* void) (+ (path block > data) (path block > size)))
(set (path block > size) (+ (path block > size) size))
(return start))
@ -79,7 +81,8 @@
;; (var stack-before-my-operation chain-allocation (deref last-chain-link)) ;; Copy it to save the capacity
;; (var my-stack-allocator-root chain-allocation last-chain-link)
;; (var working-allocator (* chain-allocation) last-chain-link)
;; (var thing (* void) (chain-allocate (addr working-allocator) (sizeof thing)))
;; (var my-thing (* thing) (chain-allocate-aligned (addr working-allocator)
;; (sizeof thing) (alignof thing)))
;; ;; All done, "pop" from our stack and reset the capacity
;; (chain-allocation-free my-stack-allocator-root)
;; (set (deref last-chain-link) stack-before-my-operation)
@ -99,7 +102,7 @@
(set (path new-chain > new-block-size) new-block-size)
(set (path new-chain > block . size) 0)
(set (path new-chain > block . capacity) new-block-size)
(set (path new-chain > block . data) (type-cast (+ new-chain 1) (* void)))
(set (path new-chain > block . data) (type-cast (+ new-chain 1) (* (unsigned char))))
(return new-chain))
(defmacro each-link-in-chain-allocator (root any current-link-name symbol next-link-name symbol
@ -116,22 +119,12 @@
;; Must pass in the first block, not the final chain pointer!
(defun chain-allocation-free (root (* chain-allocation))
(each-link-in-chain-allocator root current-link next-link
(free current-link)))
(free current-link)))
;; You must pass in the address of chain because the chain may be extended
(defun chain-allocate (last-link-in-chain-in-out (* (* chain-allocation)) size size_t
&return (* void))
(var requested-size size_t size)
(defun-local chain-allocate-new-link (last-link-in-chain-in-out (* (* chain-allocation))
requested-size size_t)
(var current-link (* chain-allocation) (deref last-link-in-chain-in-out))
(assert (and (not (path current-link > next-link))
"chain-allocate called with link that is not the last link in the chain."))
(var memory (* void) null)
;; Enough room in this link?
(when (<= requested-size (- (path current-link > block . capacity)
(path current-link > block . size)))
(return (linear-allocate (addr (path current-link > block)) requested-size)))
;; Not enough space in current link; let's allocate a new link
;; If the requested size is less than the chain has been allocating, use the chain size to
;; minimize allocations. If the size is larger, use that, and be fine having a chain with blocks
;; bigger than the max size. This isn't going to be very efficient for the next allocation, which
@ -140,11 +133,84 @@
(var requested-block-size size_t chain-block-size)
(when (> requested-size chain-block-size)
(set requested-block-size requested-size))
(var new-link (* chain-allocation) (chain-allocation-create requested-block-size))
(set (path current-link > next-link) new-link)
(set (deref last-link-in-chain-in-out) new-link)
(return (linear-allocate (addr (path new-link > block)) requested-size)))
(set (deref last-link-in-chain-in-out) new-link))
;; You must pass in the address of chain because the chain may be extended
(defun-local chain-allocate-internal (last-link-in-chain-in-out (* (* chain-allocation))
requested-size size_t
&return (* void))
(var current-link (* chain-allocation) (deref last-link-in-chain-in-out))
(assert (and (not (path current-link > next-link))
"chain-allocate-internal called with link that is not the last link in the chain."))
(var memory (* void) null)
;; Enough room in this link?
(when (<= requested-size (- (path current-link > block . capacity)
(path current-link > block . size)))
(return (linear-allocate (addr (path current-link > block)) requested-size)))
;; Not enough space in current link; let's allocate a new link
(chain-allocate-new-link last-link-in-chain-in-out requested-size)
(return (linear-allocate (addr (path (deref last-link-in-chain-in-out) > block)) requested-size)))
;; Use for streams of bytes and strings. Do not use for structs or data larger than byte alignment,
;; or performance will suffer.
(defun chain-allocate-unaligned (last-link-in-chain-in-out (* (* chain-allocation)) size size_t
&return (* void))
(return (chain-allocate-internal last-link-in-chain-in-out size)))
;; Use for structured data
(defun chain-allocate-aligned (last-link-in-chain-in-out (* (* chain-allocation)) size size_t
alignment (unsigned int)
&return (* void))
;; Used to goto back to the free space alignment when we need a new block
(each-in-range 2 num-passes
;; Eat up some extra bytes to ensure alignment
(var current-block (* block-allocation) (addr (path (deref last-link-in-chain-in-out) > block)))
(var next-free-memory (* (const (unsigned char))) (+ (path current-block > data)
(path current-block > size)))
(var-cast-to throwaway-bytes uintptr_t
(- alignment
(mod (type-cast (+ next-free-memory alignment) uintptr_t)
alignment)))
(when (= alignment throwaway-bytes) ;; Already exactly aligned
(set throwaway-bytes 0))
(var total-size-to-request size_t (+ throwaway-bytes size))
;; Resulting address is result of allocation + throwaway-bytes
(if (<= total-size-to-request (- (path current-block > capacity)
(path current-block > size)))
(scope ;; Enough space. Allocate it!
(var-cast-to space-before-alignment (* (unsigned char))
(chain-allocate-internal last-link-in-chain-in-out
total-size-to-request))
(return (type-cast (+ space-before-alignment throwaway-bytes) (* void))))
(scope ;; Need a new block. We need to allocate the new block and re-compute alignment.
;; Our data is going to start immediately after the block header. Let's make sure we request
;; enough memory to do our alignment, assuming the block header is completely unaligned and a
;; weird size. The blocks should be much bigger than our requested size anyways, but this
;; guarantees that we will be able to align even if that isn't the case.
(var minimum-size-to-request size_t (+ size alignment))
(chain-allocate-new-link last-link-in-chain-in-out minimum-size-to-request)))) ;; Go back to enough-space branch!
(allocate-failure "chain-allocate-aligned failed to return aligned memory. Either
chain-allocate-new-link or chain-allocate-internal failed, or there is a logic issue.")
(return null))
(defmacro chain-allocate-aligned-type (chain any type any &optional count any)
(if count
(tokenize-push output
(type-cast (chain-allocate-aligned
(token-splice chain)
(* (token-splice count) (sizeof (type (token-splice type))))
(alignof (type (token-splice type))))
(* (token-splice type))))
(tokenize-push output
(type-cast (chain-allocate-aligned
(token-splice chain)
(sizeof (type (token-splice type)))
(alignof (type (token-splice type))))
(* (token-splice type)))))
(return true))
;;
;; Error handling behavior
@ -212,26 +278,73 @@
(unless chain
(fprintf stderr "Expected to successfully create chain, but it failed\n")
(return 1))
(unless (chain-allocate (addr chain) 32)
(unless (chain-allocate-unaligned (addr chain) 32)
(fprintf stderr "Failed linear allocation\n")
(chain-allocation-free chain)
(chain-allocation-free chain-root)
(return 1))
(unless (chain-allocate (addr chain) 32)
(unless (chain-allocate-unaligned (addr chain) 32)
(fprintf stderr "Failed linear allocation to full link\n")
(chain-allocation-free chain)
(chain-allocation-free chain-root)
(return 1))
(var previous-link (* chain-allocation) chain)
(unless (and (chain-allocate (addr chain) 32) (!= previous-link chain))
(unless (and (chain-allocate-unaligned (addr chain) 32) (!= previous-link chain))
(fprintf stderr "Failed re-allocation after full link\n")
(chain-allocation-free chain)
(chain-allocation-free chain-root)
(return 1))
(set previous-link chain)
(unless (and (chain-allocate (addr chain) 128) (!= previous-link chain))
(unless (and (chain-allocate-unaligned (addr chain) 128) (!= previous-link chain))
(fprintf stderr "Failed allocation after requesting size larger than block\n")
(chain-allocation-free chain)
(chain-allocation-free chain-root)
(return 1))
;; Check alignment
;; Make sure we're at a wacky alignment
(chain-allocate-unaligned (addr chain) 3)
(defstruct my-align-struct
thing (* void)
c (unsigned char))
(var-cast-to first-aligned (* my-align-struct)
(chain-allocate-aligned (addr chain)
(sizeof (type my-align-struct))
(alignof (type my-align-struct))))
(unless (and first-aligned
(= 0 (mod (type-cast first-aligned ptrdiff_t) (alignof (type my-align-struct)))))
(fprintf stderr "Failed aligned allocation\n")
(chain-allocation-free chain-root)
(return 1))
;; Ensure we are packed nicely once the first element is aligned
(var-cast-to second-aligned (* my-align-struct)
(chain-allocate-aligned (addr chain)
(sizeof (type my-align-struct))
(alignof (type my-align-struct))))
(unless (and second-aligned
(= 0 (mod (type-cast second-aligned ptrdiff_t) (alignof (type my-align-struct))))
(= (+ 1 first-aligned) second-aligned))
(fprintf stderr "Failed aligned allocation with subsequent aligned element\n")
(chain-allocation-free chain-root)
(return 1))
;; Make sure to exercise case where block is too small to fit aligned struct
(each-in-range 100 i
(var-cast-to many-aligned (* my-align-struct)
(chain-allocate-aligned (addr chain)
(sizeof (type my-align-struct))
(alignof (type my-align-struct))))
(unless (and many-aligned
(= 0 (mod (type-cast many-aligned ptrdiff_t) (alignof (type my-align-struct)))))
(fprintf stderr "Failed aligned allocation %d\n" i)
(chain-allocation-free chain-root)
(return 1)))
;; Use valgrind to verify this one
(var num-contiguous (const int) 100)
(var contiguous-aligned-array (* my-align-struct)
(chain-allocate-aligned-type (addr chain) my-align-struct num-contiguous))
(each-in-range num-contiguous i
(set (field (at i contiguous-aligned-array) c) 'a'))
(each-link-in-chain-allocator chain-root current-link next-link
(fprintf stderr "Chain block %p\n\tsize %d\n\tcapacity %d\n"
current-link (type-cast (path current-link > block . size) int)

Loading…
Cancel
Save