summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--chickadee/graphics/buffer.scm42
1 files 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."