From dd89d1ab789333a4c29d91aa250b80609ffdeb09 Mon Sep 17 00:00:00 2001
From: Macoy Madson <macoy@macoy.me>
Date: Sat, 29 Jan 2022 11:12:59 -0500
Subject: [PATCH] Added WIP allocator

---
 src/Allocator.cake         | 110 +++++++++++++++++++++++++++++++++++++
 test/src/GameLibTests.cake |   8 +--
 2 files changed, 114 insertions(+), 4 deletions(-)
 create mode 100644 src/Allocator.cake

diff --git a/src/Allocator.cake b/src/Allocator.cake
new file mode 100644
index 0000000..3ef1da1
--- /dev/null
+++ b/src/Allocator.cake
@@ -0,0 +1,110 @@
+;; Allocator.cake: Specialized allocators for performance and convenience
+;; Define 'Allocator-no-asserts if your program is set up to handle memory failures
+(add-cakelisp-search-directory "Dependencies/cakelisp/runtime")
+(import "CHelpers.cake")
+
+(c-import "<stdlib.h>"
+          "<assert.h>")
+
+(comptime-cond
+ ('auto-test
+  (c-import "<stdio.h>")))
+
+(forward-declare (struct block-allocation))
+
+(defstruct-local block-allocation
+  size size_t
+  capacity size_t
+  data (* void))
+
+(defun-local block-allocation-create (size size_t &return (* block-allocation))
+  ;; Create the header alongside the block so it can all go away in one free
+  (var-cast-to new-block (* block-allocation) (malloc (+ size (sizeof (type block-allocation)))))
+  (unless new-block
+    (allocate-failure "System malloc failed. System out of memory?")
+    (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)))
+  (return new-block))
+
+(defun-local block-allocation-free (block (* block-allocation))
+  (free block))
+
+;;
+;; Simple linear allocator based on a single block
+;;
+
+(defun-local linear-allocate (block (* block-allocation) size size_t &return (* void))
+  (unless (and block (path block > data))
+    (allocate-failure "block allocation was not initialized")
+    (return null))
+  ;; failed to allocate: not enough capacity for requested size
+  (unless (<= size (- (path block > capacity) (path block > size)))
+    (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)))
+  (set (path block > size) (+ (path block > size) size))
+  (return start))
+
+(defun-local linear-allocate-clear (block (* block-allocation))
+  (when block
+    (set (path block > size) 0)))
+
+(defmacro allocate-failure (message string)
+  (comptime-cond
+   ('Allocator-no-asserts)
+   ;; If in testing, we want to trigger errors without asserting
+   ('auto-test
+    (tokenize-push output
+      (fprintf stderr "%s\n" (token-splice message))))
+   ;; Assert on memory failures
+   (true
+    (tokenize-push output
+      (assert (and 0 (token-splice message))))))
+  (return true))
+
+;;
+;; Tests
+;;
+
+(comptime-cond
+ ('auto-test
+  (defun test--allocators (&return int)
+    (var block (* block-allocation) (block-allocation-create 1024))
+    (unless (and block (path block > data))
+      (fprintf stderr "Failed to allocate a block\n")
+      (return 1))
+
+    (scope
+     (var fail-item (* void) (linear-allocate block 1025))
+     (when fail-item
+       (fprintf stderr "Expected to fail to allocate, but it succeeded\n")
+       (block-allocation-free block)
+       (return 1)))
+
+    (scope
+     ;; Linear allocate
+     (var succeed-item (* void) (linear-allocate block 1024))
+     (unless succeed-item
+       (fprintf stderr "Expected to successfully allocate, but it failed\n")
+       (block-allocation-free block)
+       (return 1))
+     (fprintf stderr "Address of block: %p\nAddress of item: %p\n" block succeed-item)
+     ;; Linear allocate from a full block (fail)
+     (var fail-item (* void) (linear-allocate block 1))
+     (when fail-item
+       (fprintf stderr "Expected to fail to allocate, but it succeeded\n")
+       (block-allocation-free block)
+       (return 1))
+     ;; Linear allocate from a cleared block
+     (linear-allocate-clear block)
+     (set succeed-item (linear-allocate block 1024))
+     (unless succeed-item
+       (fprintf stderr "Expected to successfully allocate, but it failed\n")
+       (block-allocation-free block)
+       (return 1)))
+
+    (block-allocation-free block)
+    (return 0))))
diff --git a/test/src/GameLibTests.cake b/test/src/GameLibTests.cake
index f636e42..144ca1b 100644
--- a/test/src/GameLibTests.cake
+++ b/test/src/GameLibTests.cake
@@ -37,8 +37,8 @@
      (true
       "src/Config_Linux.cake")))
 
-  ;; (var test-minimal bool true)
-  (var test-minimal bool false)
+  (var test-minimal bool true)
+  ;; (var test-minimal bool false)
 
   ;; (var test-opengl-only bool true)
   (var test-opengl-only bool false)
@@ -54,7 +54,7 @@
              "../src/AutoTest.cake" "../src/Introspection.cake"
              "../src/Dictionary.cake" "../src/DynamicArray.cake"
              "../src/TaskSystem.cake" "../src/Image.cake" "../src/DataBundle.cake"
-             "../src/TinyCCompiler.cake" "../src/FreeType.cake")))
+             "../src/TinyCCompiler.cake" "../src/FreeType.cake" "../src/Allocator.cake")))
 
     (test-opengl-only
      (gamelib-run-test
@@ -69,7 +69,7 @@
              "../src/AutoTest.cake" "../src/SDL.cake" "../src/Math.cake"
              "../src/Aubio.cake" "../src/ImGui.cake" "../src/Dictionary.cake"
              "../src/DynamicArray.cake" "../src/Introspection.cake" "../src/OpenGL.cake"
-             "../src/Tracy.cake" "../src/TaskSystem.cake"
+             "../src/Tracy.cake" "../src/TaskSystem.cake" "../src/Allocator.cake"
              ;; Note that Raylib must come first so Image knows not to redefine stb_image implementation
              "../src/Raylib.cake" "../src/Image.cake"
              "../src/DataBundle.cake" "../src/TinyCCompiler.cake" "../src/FreeType.cake"