diff options
| -rw-r--r-- | chickadee/graphics/buffer.scm | 42 |
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." |