-
-
Notifications
You must be signed in to change notification settings - Fork 46
/
resource.lisp
94 lines (73 loc) · 2.82 KB
/
resource.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
(in-package #:org.shirakumo.fraf.trial)
;; FIXME: configurable defaults
(defclass loadable () ())
(defclass resource (loadable)
((generator :initarg :generator :initform NIL :reader generator)
(name :initarg :name :initform NIL :reader name)
(dependencies :initarg :dependencies :initform () :accessor dependencies)))
(defmethod print-object ((resource resource) stream)
(print-unreadable-object (resource stream :type T :identity T)
(format stream "~@[~a~]~@[ ~a~]~:[~; ALLOCATED~]" (generator resource) (name resource) (allocated-p resource))))
(defgeneric allocate (resource))
(defgeneric deallocate (resource))
(defgeneric allocated-p (resource))
(defmethod load ((resource resource))
(unless (allocated-p resource)
(v:trace :trial.resource "Loading ~a" resource)
(allocate resource)))
(defmethod allocate :around ((resource resource))
#-elide-allocation-checks
(when (allocated-p resource)
(error "~a is already loaded!" resource))
#-trial-release
(v:trace :trial.resource "Allocating ~a" resource)
(call-next-method)
resource)
(defmethod deallocate :around ((resource resource))
#-elide-allocation-checks
(unless (allocated-p resource)
(error "~a is not loaded!" resource))
#-trial-release
(v:trace :trial.resource "Deallocating ~a" resource)
(call-next-method)
resource)
(defmethod loaded-p ((resource resource))
(allocated-p resource))
(defmethod finalize ((resource resource))
(when (allocated-p resource)
(deallocate resource)))
(defun check-allocated (resource)
(unless (allocated-p resource)
(restart-case
(error 'resource-not-allocated :resource resource)
(continue ()
:report "Allocate the resource now and continue."
(allocate resource)))))
(defun ensure-allocated (resource)
(unless (allocated-p resource)
(mapc #'ensure-allocated (dependencies resource))
(handler-bind ((resource-not-allocated #'continue))
(allocate resource)))
resource)
(defclass foreign-resource (resource)
((data-pointer :initform NIL :initarg :data-pointer :accessor data-pointer)))
(defmethod allocated-p ((resource foreign-resource))
(data-pointer resource))
(defmethod deallocate :after ((resource foreign-resource))
(setf (data-pointer resource) NIL))
(defclass gl-resource (foreign-resource)
((data-pointer :accessor gl-name)))
(defgeneric activate (gl-resource))
(defgeneric deactivate (gl-resource))
#-elide-context-current-checks
(defmethod allocate :before ((resource gl-resource))
(check-context-current))
#-elide-context-current-checks
(defmethod deallocate :before ((resource gl-resource))
(check-context-current))
#-elide-context-current-checks
(defmethod activate :before ((resource gl-resource))
(check-context-current))
#-elide-context-current-checks
(defmethod deactivate :before ((resource gl-resource))
(check-context-current))