From 515ba05517c3fdf92aeb1e37c1ab5af320586604 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Sat, 29 Apr 2023 11:41:19 -0400 Subject: Reduce garbage generated by graphics state management. --- chickadee/graphics/engine.scm | 96 ++++++++++++++++--------------------------- 1 file changed, 36 insertions(+), 60 deletions(-) (limited to 'chickadee') diff --git a/chickadee/graphics/engine.scm b/chickadee/graphics/engine.scm index 7fe6def..ed0650e 100644 --- a/chickadee/graphics/engine.scm +++ b/chickadee/graphics/engine.scm @@ -42,14 +42,15 @@ ;; GPU when the value really needs updating. (define-record-type - (%make-graphics-state-spec name default binder) + (%make-graphics-state-spec id name default binder) graphics-state-spec? + (id graphics-state-spec-id) (name graphics-state-spec-name) (default graphics-state-spec-default) (binder graphics-state-spec-binder)) -(define* (make-graphics-state-spec name #:key default bind) - (%make-graphics-state-spec name default bind)) +(define* (make-graphics-state-spec id name #:key default bind) + (%make-graphics-state-spec id name default bind)) (define-record-type (%make-graphics-state binder value bound-value dirty? stack) @@ -83,18 +84,28 @@ (set-graphics-state-bound-value! state x) (set-graphics-state-dirty! state #f)))) -(define *graphics-states* (make-hash-table)) +(define *graphics-states* (make-array-list)) + +;; Box the counter so the compiler doesn't do constant propagation on +;; it and screw everything up. +(define *graphics-state-id-counter* (vector 0)) + +(define (next-graphics-state-id) + (let ((id (vector-ref *graphics-state-id-counter* 0))) + (vector-set! *graphics-state-id-counter* 0 (+ id 1)) + id)) (define-syntax-rule (define-graphics-state name getter args ...) (begin (define name - (let ((spec (make-graphics-state-spec 'name args ...))) - (hashq-set! *graphics-states* 'name spec) + (let* ((id (next-graphics-state-id)) + (spec (make-graphics-state-spec id 'name args ...))) + (array-list-push! *graphics-states* spec) (when (current-graphics-engine) (install-graphics-state (current-graphics-engine) spec)) spec)) (define* (getter #:optional (engine (current-graphics-engine))) - (graphics-engine-state-ref 'name engine)))) + (graphics-engine-state-ref name engine)))) ;;; @@ -161,8 +172,7 @@ (define-record-type (%make-graphics-engine gl-context gl-version glsl-version max-texture-size - projection-matrix guardian states modified-states - variables) + projection-matrix guardian states variables) graphics-engine? (gl-context %graphics-engine-gl-context) (gl-version %graphics-engine-gl-version) @@ -172,14 +182,13 @@ %set-graphics-engine-projection-matrix!) (guardian graphics-engine-guardian) (states graphics-engine-states) - (modified-states graphics-engine-modified-states) (variables graphics-engine-variables)) (define (install-graphics-state engine spec) (let ((binder (graphics-state-spec-binder spec)) (default (graphics-state-spec-default spec))) - (hashq-set! (graphics-engine-states engine) - (graphics-state-spec-name spec) + (hashv-set! (graphics-engine-states engine) + (graphics-state-spec-id spec) (make-graphics-state binder default)))) (define (install-graphics-variable engine var) @@ -204,15 +213,14 @@ (make-identity-matrix4) (make-guardian) (make-hash-table) - (make-hash-table) (make-hash-table)))) ;; Variable initialization must be delayed until after engine ;; creation because variable initializers may modify graphics ;; engine state to create shaders, textures, etc. (parameterize ((current-graphics-engine engine)) - (hash-for-each (lambda (key spec) - (install-graphics-state engine spec)) - *graphics-states*) + (array-list-for-each (lambda (i spec) + (install-graphics-state engine spec)) + *graphics-states*) (hash-for-each (lambda (key var) (install-graphics-variable engine var)) *graphics-variables*)) @@ -249,43 +257,25 @@ (define* (set-graphics-engine-projection-matrix! matrix #:optional (engine (current-graphics-engine))) (%set-graphics-engine-projection-matrix! engine matrix)) -(define* (graphics-engine-state-ref name #:optional +(define* (graphics-engine-state-ref spec #:optional (engine (current-graphics-engine))) - (let ((state (hashq-ref (graphics-engine-states engine) name))) - (if state - (graphics-state-ref state) - (error - (format #f - "No such graphics state '~a'. Did you include the module that defines it?" - name))))) - -(define* (graphics-engine-state-set! name value #:optional - (engine (current-graphics-engine))) - (let ((state (hashq-ref (graphics-engine-states engine) name))) - (graphics-state-set! state value) - (hashq-set! (graphics-engine-modified-states engine) - name - #t))) + (let ((state (hashv-ref (graphics-engine-states engine) + (graphics-state-spec-id spec)))) + (and state (graphics-state-ref state)))) (define* (graphics-engine-state-push! spec value #:optional (engine (current-graphics-engine))) (if (graphics-state-spec? spec) - (let ((name (graphics-state-spec-name spec))) - (graphics-state-push! (hashq-ref (graphics-engine-states engine) name) - value) - (hashq-set! (graphics-engine-modified-states engine) - name - #t)) + (let ((id (graphics-state-spec-id spec))) + (graphics-state-push! (hashv-ref (graphics-engine-states engine) id) + value)) (error "not a graphics state specification" spec))) (define* (graphics-engine-state-pop! spec #:optional (engine (current-graphics-engine))) (if (graphics-state-spec? spec) - (let ((name (graphics-state-spec-name spec))) - (graphics-state-pop! (hashq-ref (graphics-engine-states engine) name)) - (hashq-set! (graphics-engine-modified-states engine) - name - #t)) + (let ((id (graphics-state-spec-id spec))) + (graphics-state-pop! (hashv-ref (graphics-engine-states engine) id))) (error "not a graphics state specification" spec))) (define* (graphics-variable-ref var #:optional @@ -297,12 +287,9 @@ (hashq-set! (graphics-engine-variables engine) var value)) (define* (graphics-engine-commit! #:optional (engine (current-graphics-engine))) - (let ((states (graphics-engine-states engine)) - (modified-states (graphics-engine-modified-states engine))) - (hash-for-each (lambda (key value) - (graphics-state-bind-maybe (hashq-ref states key))) - modified-states) - (hash-clear! modified-states))) + (hash-for-each (lambda (id state) + (graphics-state-bind-maybe state)) + (graphics-engine-states engine))) (define* (graphics-engine-guard! obj #:optional (engine (current-graphics-engine))) @@ -330,17 +317,6 @@ (lambda () (graphics-engine-state-pop! spec) ...))) -;; (define-syntax-rule (with-graphics-state ((spec value) ...) body ...) -;; (let ((thunk (lambda () -;; (graphics-engine-state-set! (graphics-state-spec-name spec) value) ... -;; body ...)) -;; (spec (graphics-engine-state-ref (graphics-state-spec-name spec))) -;; ...) -;; (let ((result (thunk))) -;; ;; Restore old values -;; (graphics-engine-state-set! (graphics-state-spec-name spec) spec) ... -;; result))) - (define-syntax-rule (with-graphics-state! ((spec value) ...) body ...) (with-graphics-state ((spec value) ...) (graphics-engine-commit!) -- cgit v1.2.3