-
-
Notifications
You must be signed in to change notification settings - Fork 46
/
data-pointer.lisp
65 lines (53 loc) · 2.49 KB
/
data-pointer.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
(in-package #:org.shirakumo.fraf.trial)
(defmethod deallocate (data)
(typecase data
(cffi:foreign-pointer
(cffi:foreign-free data))
(T
(no-applicable-method #'deallocate data))))
(defmethod deallocate ((vector vector))
(maybe-free-static-vector vector))
(defmethod deallocate ((mem memory-region))
(mem:deallocate T mem))
(defmethod deallocate ((source texture-source))
(deallocate (pixel-data source)))
(defmethod deallocate ((list list))
(mapc #'deallocate list))
(defmethod mem:call-with-memory-region (function (data vec2) &key (offset 0))
#-elide-buffer-access-checks
(when (/= offset 0) (error "OFFSET must be zero for vectors."))
(cffi:with-foreign-object (ptr :float 2)
(setf (cffi:mem-aref ptr :float 0) (vx2 data))
(setf (cffi:mem-aref ptr :float 1) (vy2 data))
(let ((region (memory-region ptr (* 2 4))))
(declare (dynamic-extent region))
(funcall function region))))
(defmethod mem:call-with-memory-region (function (data vec3) &key (offset 0))
#-elide-buffer-access-checks
(when (/= offset 0) (error "OFFSET must be zero for vectors."))
(cffi:with-foreign-object (ptr :float 3)
(setf (cffi:mem-aref ptr :float 0) (vx3 data))
(setf (cffi:mem-aref ptr :float 1) (vy3 data))
(setf (cffi:mem-aref ptr :float 2) (vz3 data))
(let ((region (memory-region ptr (* 3 4))))
(declare (dynamic-extent region))
(funcall function region))))
(defmethod mem:call-with-memory-region (function (data vec4) &key (offset 0))
#-elide-buffer-access-checks
(when (/= offset 0) (error "OFFSET must be zero for vectors."))
(cffi:with-foreign-object (ptr :float 4)
(setf (cffi:mem-aref ptr :float 0) (vx4 data))
(setf (cffi:mem-aref ptr :float 1) (vy4 data))
(setf (cffi:mem-aref ptr :float 2) (vz4 data))
(setf (cffi:mem-aref ptr :float 3) (vw4 data))
(let ((region (memory-region ptr (* 4 4))))
(declare (dynamic-extent region))
(funcall function region))))
(defmethod mem:call-with-memory-region (function (data mat2) &rest args)
(apply #'mem:call-with-memory-region function (marr2 data) args))
(defmethod mem:call-with-memory-region (function (data mat3) &rest args)
(apply #'mem:call-with-memory-region function (marr3 data) args))
(defmethod mem:call-with-memory-region (function (data mat4) &rest args)
(apply #'mem:call-with-memory-region function (marr4 data) args))
(defmethod mem:call-with-memory-region (function (data matn) &rest args)
(apply #'mem:call-with-memory-region function (marrn data) args))