Use invoker to avoid consing closures

borodust · Aug 13, 2019 · 0c03810 · 0c03810
1 parent 9945079
commit 0c03810
Show file tree

Hide file tree

Showing 3 changed files with 36 additions and 17 deletions.
diff --git a/engine/engine.lisp b/engine/engine.lisp
@@ -308,19 +308,27 @@ initialized."
 
 
 (defun acquire-executor (&rest args &key (single-threaded-p nil) (exclusive-p nil)
-                                      (special-variables nil))
+                                      (special-variables nil)
+                                      (invoker nil))
   "Acquire executor from the engine, properties of which correspond to provided options:
 :single-threaded-p - if t, executor will be single-threaded, otherwise it can be pooled one
 :exclusive-p - if t, this executor cannot be acquired by other requester and :special-variables
                can be specified for it, otherwise this executor could be shared among different
                requesters."
   (with-slots (shared-pool shared-executors) *engine*
     (cond
-      ((and (not exclusive-p) (not single-threaded-p) (not special-variables))
+      ((and (not exclusive-p)
+            (not single-threaded-p)
+            (not special-variables)
+            (not invoker))
        shared-pool)
       ((and exclusive-p single-threaded-p)
-       (make-single-threaded-executor :special-variables special-variables))
-      ((and single-threaded-p (not exclusive-p) (not special-variables))
+       (make-single-threaded-executor :special-variables special-variables
+                                      :invoker invoker))
+      ((and single-threaded-p
+            (not exclusive-p)
+            (not special-variables)
+            (not invoker))
        (first shared-executors))
       (t (error "Cannot provide executor for combination of requirements: ~a" args)))))
 

diff --git a/graphics/context.lisp b/graphics/context.lisp
@@ -11,11 +11,26 @@
    (depth-stencil-renderbuffer :initform nil :reader %depth-stencil-renderbuffer-of)
    (framebuffer-width :initform 0 :reader %framebuffer-width-of)
    (framebuffer-height :initform 0 :reader %framebuffer-height-of)
-   (executor :initform (acquire-executor :single-threaded-p t :exclusive-p t) :reader %executor-of)))
+   (executor :initform nil :reader %executor-of)))
+
+
+(defmethod initialize-instance :after ((this graphics-context) &key system)
+  (with-slots (executor) this
+    (flet ((%invoke (task)
+             (let ((*system* system)
+                   (*graphics-context* this)
+                   (*supplementary-framebuffer* (%supplementary-framebuffer-of this))
+                   (*depth-stencil-renderbuffer* (%depth-stencil-renderbuffer-of this)))
+               (funcall task))))
+      (setf executor (acquire-executor :single-threaded-p t
+                                       :exclusive-p t
+                                       :invoker #'%invoke)))))
 
 
 (defun initialize-graphics-context (this)
-  (with-slots (rendering-context state supplementary-framebuffer depth-stencil-renderbuffer) this
+  (with-slots (rendering-context state
+               supplementary-framebuffer depth-stencil-renderbuffer)
+      this
     (bind-rendering-context (if (eq rendering-context t)
                                 nil
                                 rendering-context))

diff --git a/graphics/system.lisp b/graphics/system.lisp
@@ -11,7 +11,7 @@
   (with-slots (main-context) this
     (>> (~> (for-host ()
               (framebuffer-size))
-            (assembly-flow 'graphics-context :main t))
+            (assembly-flow 'graphics-context :main t :system this))
         (instantly ((viewport context))
           (declare (type vec2 viewport))
           (setf main-context context)
@@ -63,15 +63,11 @@
                      &key context disposing)
   (with-slots (main-context) this
     (let ((context (if context context main-context)))
-      (flet ((run-task ()
-               (let ((*system* this)
-                     (*graphics-context* context)
-                     (*supplementary-framebuffer* (%supplementary-framebuffer-of context))
-                     (*depth-stencil-renderbuffer* (%depth-stencil-renderbuffer-of context)))
-                 (funcall task))))
-        (if disposing
-            (apply #'execute-with-context context #'run-task :important-p t :priority :highest args)
-            (apply #'execute-with-context context #'run-task args))))))
+      (if disposing
+          (apply #'execute-with-context context task :important-p t
+                                                     :priority :highest
+                                                     args)
+          (apply #'execute-with-context context task args)))))
 
 
 (defun register-shared-context (shared-context)
@@ -81,7 +77,7 @@
 
 
 (defun graphics-context-assembly-flow ()
-  (>> (assembly-flow 'graphics-context)
+  (>> (assembly-flow 'graphics-context :system (graphics))
       (for-graphics (instance)
         (register-shared-context instance))))