diff options
author | David Thompson <dthompson2@worcester.edu> | 2016-02-15 14:52:03 -0500 |
---|---|---|
committer | David Thompson <dthompson2@worcester.edu> | 2016-02-15 14:52:03 -0500 |
commit | 0de5247b7653394bf9ceecfc17d188dab3c7bcd5 (patch) | |
tree | 6ef8d323c32ed62bbdd90ea72f541e414c848d25 /sly/guardian.scm | |
parent | 000315b8f5e2cfe45db0ebfe42f9208c9c0d95e1 (diff) |
Use a single foreign object guardian.
Rather than each foreign resource type creating its own guardian, let's
just use one instead so that there is only a single guardian to talk to
each frame.
* sly/guardian.scm: New file.
* Makefile.am (SOURCES): Add it.
* sly/game.scm (run-game-loop): Start guardian worker.
* sly/render/mesh.scm (mesh-guardian): Delete.
(free-mesh): New procedure.
(make-mesh): Guard newly created meshes.
* sly/render/shader.scm (shader-stage-guardian): Delete.
(free-shader-stage): New procedure.
(make-shader-stage): Guard newly created shader stages.
(shader-guardian): Delete.
(free-shader): New procedure.
(make-shader): Guard newly created shaders.
* sly/render/texture.scm (texture-guardian): Delete.
(free-texture): New procedure.
(make-texture): Guard newly created textures.
Diffstat (limited to 'sly/guardian.scm')
-rw-r--r-- | sly/guardian.scm | 69 |
1 files changed, 69 insertions, 0 deletions
diff --git a/sly/guardian.scm b/sly/guardian.scm new file mode 100644 index 0000000..6bdfcd0 --- /dev/null +++ b/sly/guardian.scm @@ -0,0 +1,69 @@ +;;; Sly +;;; Copyright © 2016 David Thompson <davet@gnu.org> +;;; +;;; Sly is free software: you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation, either version 3 of the License, or +;;; (at your option) any later version. +;;; +;;; Sly is distributed in the hope that it will be useful, but WITHOUT +;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +;;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public +;;; License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program. If not, see +;;; <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Garbage collector for foreign objects. +;; +;;; Code: + +(define-module (sly guardian) + #:use-module (ice-9 match) + #:use-module (sly agenda) + #:export (register-finalizer + guard + run-guardian)) + +(define-syntax-rule (push! variable value) + (set! variable (cons value variable))) + +(define %guardian (make-guardian)) + +(define %finalizers '()) + +(define (register-finalizer predicate finalizer) + "Register FINALIZER, a procedure that frees a foreign resource, to +be used for objects that satisfy PREDICATE." + (push! %finalizers (cons predicate finalizer))) + +(define (guard obj) + "Protect OBJ from garbage collection until its finalizer has been +applied. OBJ is returned unmodified." + (%guardian obj) + obj) + +(define (lookup-finalizer obj) + "Return the finalization procedure for OBJ, or #f if none is found." + (let loop ((finalizers %finalizers)) + (match finalizers + (() #f) + (((predicate . finalizer) . rest) + (if (predicate obj) + finalizer + (loop rest)))))) + +(define (run-guardian) + "Start the guardian worker coroutine on the current agenda." + (schedule-each + (lambda () + (let loop ((obj (%guardian))) + (when obj + (let ((finalizer (lookup-finalizer obj))) + (if finalizer + (finalizer obj) + (error "no finalizer found for object" obj))) + (loop (%guardian))))))) |