From 870f58d55abfd1bed74494ff8830b81d3610e292 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Mon, 1 May 2023 08:01:02 -0400
Subject: Cache bytevectors for streaming buffers to reduce GC.

---
 chickadee/graphics/buffer.scm | 42 +++++++++++++++++++++++++++++++++---------
 1 file changed, 33 insertions(+), 9 deletions(-)

diff --git a/chickadee/graphics/buffer.scm b/chickadee/graphics/buffer.scm
index 514f34b..b18309e 100644
--- a/chickadee/graphics/buffer.scm
+++ b/chickadee/graphics/buffer.scm
@@ -111,7 +111,7 @@
 ;;;
 
 (define-record-type <buffer>
-  (%make-buffer id name length stride target usage data)
+  (%make-buffer id name length stride target usage data stream-cache)
   buffer?
   (id buffer-id)
   (name buffer-name)
@@ -119,7 +119,8 @@
   (stride buffer-stride)
   (target buffer-target)
   (usage buffer-usage)
-  (data buffer-data set-buffer-data!))
+  (data buffer-data set-buffer-data!)
+  (stream-cache buffer-stream-cache))
 
 (set-record-type-printer! <buffer>
                           (lambda (buffer port)
@@ -133,7 +134,7 @@
                                     (buffer-stride buffer))))
 
 (define null-buffer
-  (%make-buffer 0 "null" 0 0 'vertex 'static #f))
+  (%make-buffer 0 "null" 0 0 'vertex 'static #f #f))
 
 (define (free-buffer buffer)
   (gl-delete-buffers 1 (u32vector (buffer-id buffer))))
@@ -211,7 +212,9 @@ never sent to the GPU."
                                 stride
                                 target
                                 usage
-                                #f)))
+                                #f
+                                (and (eq? usage 'stream)
+                                     (make-hash-table)))))
       (graphics-engine-guard! buffer)
       (with-graphics-state! ((g:buffer buffer))
         (gl-buffer-data (buffer-target-gl buffer)
@@ -226,6 +229,22 @@ never sent to the GPU."
   "Return #t if buffer data has been mapped from GPU."
   (if (buffer-data buffer) #t #f))
 
+;; For streaming buffers, we use buffer re-specification to achieve
+;; good throughput.  However, it requires getting a new data pointer
+;; every frame and allocating a Scheme bytevector for that memory
+;; region.  Allocating this bytevector every frame causes significant
+;; GC pressure.  It turns out that, GPU drivers tend to return the
+;; same set of pointers over and over.  So, by caching bytevectors for
+;; those memory regions we avoid bytevector allocation after a frame
+;; or two of warmup.
+(define (pointer->bytevector/cached buffer pointer length)
+  (let ((cache (buffer-stream-cache buffer))
+        (address (pointer-address pointer)))
+    (or (hashv-ref cache address)
+        (let ((bv (pointer->bytevector pointer length)))
+          (hashv-set! cache address bv)
+          bv))))
+
 (define* (map-buffer! buffer #:optional (mode 'read-write))
   "Map the memory space for BUFFER from the GPU to the CPU, allowing
 the vertex buffer to be updated with new vertex data.  The
@@ -239,11 +258,16 @@ vertex buffer data back to the GPU."
           ;; Orphan the buffer to avoid implicit synchronization.
           ;; See: https://www.opengl.org/wiki/Buffer_Object_Streaming#Buffer_re-specification
           (gl-buffer-data target length %null-pointer (buffer-usage-gl buffer)))
-        (let ((ptr (gl-map-buffer target (match mode
-                                           ('read-write (version-1-5 read-write))
-                                           ('read-only (version-1-5 read-only))
-                                           ('write-only (version-1-5 write-only))))))
-          (set-buffer-data! buffer (pointer->bytevector ptr length)))))))
+        (let* ((ptr (gl-map-buffer target
+                                   (case mode
+                                     ((read-write)
+                                      (version-1-5 read-write))
+                                     ((read-only)
+                                      (version-1-5 read-only))
+                                     ((write-only)
+                                      (version-1-5 write-only)))))
+               (bv (pointer->bytevector/cached buffer ptr length)))
+          (set-buffer-data! buffer bv))))))
 
 (define (unmap-buffer! buffer)
   "Return the mapped vertex buffer data for BUFFER to the GPU."
-- 
cgit v1.2.3