Coverage report: /home/ellis/comp/core/ffi/rocksdb/macs.lisp

KindCoveredAll%
expression9157 5.7
branch00nil
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; macs.lisp --- RocksDB Alien Macros
2
 
3
 ;; Convenience Macros for working with RocksDB Alien types
4
 
5
 ;;; Code:
6
 (in-package :rocksdb)
7
 
8
 (deftype rocksdb-mergeoperator-function ()
9
   '(function (octet-vector (or octet-vector null) &rest t) (or null octet-vector)))
10
 
11
 (deftype rocksdb-comparator-function ()
12
   '(function (octet-vector octet-vector) (integer -1 1)))
13
 
14
 (deftype rocksdb-compactionfilter-function ()
15
   ;;           level              key           val           new         changed
16
   '(function ((unsigned-byte 32) octet-vector octet-vector octet-vector) boolean))
17
 
18
 (deftype rocksdb-logger-function ()
19
   '(function (unsigned-byte string) (values)))
20
 
21
 (defmacro with-errptr (sym &body body)
22
   `(let ((,sym (alien-sap (make-alien (* (* t))))))
23
      (setf (deref (sap-alien ,sym (* (* t)))) nil)
24
      (unwind-protect (progn ,@body)
25
        (unless (null-alien (deref (sap-alien ,sym (* (* t)))))
26
          (rocksdb-c-error ,sym)))))
27
 
28
 ;;; Options
29
 (defmacro with-latest-options (db-path (db-opts-var cf-names-var cf-opts-var &optional destroy) &body body)
30
   ;;  TODO 2024-09-26: ignore unknown?
31
   (with-gensyms (db-opts cf-names cf-opts)
32
     `(with-alien ((,db-opts (* rocksdb-options))
33
                   (,cf-names (* c-string))
34
                   (,cf-opts (* (* rocksdb-options)))
35
                   (ncols size-t))
36
        (with-errptr e
37
          (rocksdb-load-latest-options 
38
           ,db-path 
39
           (rocksdb-create-default-env)
40
           t
41
           (rocksdb-cache-create-lru 1080)
42
           (addr ,db-opts)
43
           (addr ncols)
44
           (addr ,cf-names)
45
           (addr ,cf-opts)
46
           e))
47
        (let ((,db-opts-var ,db-opts)
48
              (,cf-names-var (coerce
49
                              (loop for i below ncols
50
                                    collect (deref ,cf-names i))
51
                              'vector))
52
              (,cf-opts-var (coerce
53
                             (loop for i below ncols
54
                                   collect (deref ,cf-opts i))
55
                             'vector)))
56
          (unwind-protect (unless (null-alien ,db-opts-var) ,@body)
57
            (when ,destroy (rocksdb-load-latest-options-destroy ,db-opts ,cf-names ,cf-opts ncols)))))))
58
 
59
 ;;; Merge Ops
60
 (defmacro define-full-merge-op (name &body body)
61
   `(define-alien-callable ,name (* t)
62
        #.*rocksdb-full-merge-lambda-list*
63
      ,@body))
64
 
65
 (defmacro define-partial-merge-op (name &body body)
66
   `(define-alien-callable ,name (* t)
67
        #.*rocksdb-partial-merge-lambda-list*
68
      ,@body))
69
 
70
 (defmacro define-merge-operator (name state &key full
71
                                                  partial
72
                                                  (destructor 'rocksdb-destructor)
73
                                                  (delete 'rocksdb-delete-value))
74
   (with-gensyms (fmerge pmerge mcreate mname)
75
     (setf fmerge (symbolicate name "-FULL-MERGE")
76
           pmerge (symbolicate name "-PARTIAL-MERGE")
77
           mcreate (symbolicate "CREATE-" name "-MERGEOPERATOR")
78
           mname (symbolicate name "-MERGEOPERATOR-NAME"))
79
     `(progn
80
        (define-full-merge-op ,fmerge ,@full)
81
        (define-partial-merge-op ,pmerge ,@partial)
82
        (define-alien-callable ,mname c-string () (string ',name))
83
        (defun ,mcreate ()
84
          (rocksdb-mergeoperator-create ,state
85
                                        (alien-sap (alien-callable-function ',destructor))
86
                                        (alien-sap (alien-callable-function ',fmerge))
87
                                        (alien-sap (alien-callable-function ',pmerge))
88
                                        (alien-sap (alien-callable-function ',delete))
89
                                        (alien-sap (alien-callable-function ',mname)))))))
90
 
91
 ;;; SliceTransforms
92
 (defmacro define-transform-function (name &body body)
93
   `(define-alien-callable ,name (* unsigned-char)
94
        ,*rocksdb-transform-lambda-list*
95
      ,@body))
96
 
97
 (defmacro define-in-domain-function (name &body body)
98
   `(define-alien-callable ,name (* unsigned-char)
99
        ,*rocksdb-in-domain-lambda-list*
100
      ,@body))
101
 
102
 (defmacro define-in-range-function (name &body body)
103
   `(define-alien-callable ,name (* unsigned-char)
104
        ,*rocksdb-in-range-lambda-list*
105
      ,@body))
106
 
107
 (defmacro define-slicetransform (name &key (destructor 'rocksdb-destructor)
108
                                            state
109
                                            transform
110
                                            in-domain
111
                                            in-range)
112
   (with-gensyms (in-domain-fn in-range-fn transform-fn sname screate)
113
     (setf in-domain-fn (symbolicate name "-IN-DOMAIN")
114
           in-range-fn (symbolicate name "-IN-RANGE")
115
           sname (symbolicate name "-SLICETRANSFORM-NAME")
116
           transform-fn (symbolicate name "-TRANSFORM")
117
           screate (symbolicate "CREATE-" name "-TRANSFORM"))
118
     `(progn
119
        (define-transform-function ,transform-fn ,@transform)
120
        (define-in-domain-function ,in-domain-fn ,@in-domain)
121
        (define-in-range-function ,in-range-fn ,@in-range)
122
        (define-alien-callable ,sname c-string () (string ',name))
123
        (defun ,screate ()
124
          (rocksdb-slicetransform-create ,state
125
                                         (alien-sap (alien-callable-function ',destructor))
126
                                         (alien-sap (alien-callable-function ',transform))
127
                                         (alien-sap (alien-callable-function ',in-domain-fn))
128
                                         (alien-sap (alien-callable-function ',in-range-fn))
129
                                         (alien-sap (alien-callable-function ',sname)))))))
130
 
131
 ;;; Comparator
132
 (defmacro define-compare-without-ts-function (name &body body)
133
   `(define-alien-callable ,name int
134
        ((state (* t))
135
         (a (* unsigned-char))
136
         (alen size-t)
137
         (atsp unsigned-char)
138
         (bts (* unsigned-char))
139
         (btslen size-t)
140
         (btsp unsigned-char))
141
      ,@body))
142
 
143
 (defmacro define-compare-ts-function (name &body body)
144
   `(define-alien-callable ,name int
145
        ((state (* t))
146
         (ats (* unsigned-char))
147
         (atslen size-t)
148
         (bts (* unsigned-char))
149
         (btslen size-t))
150
      ,@body))
151
 
152
 (defmacro define-compare-function (name &body body)
153
   `(define-alien-callable ,name int
154
        ((state (* t))
155
         (a (* unsigned-char))
156
         (alen size-t)
157
         (b (* unsigned-char))
158
         (blen size-t))
159
      ,@body))
160
 
161
 (defmacro define-comparator (name &key compare (destructor 'rocksdb-destructor) state)
162
   "Define a RocksDB Comparator."
163
   (with-gensyms (cname cfn ccreate)
164
     (setf cname (symbolicate name "-COMPARATOR-NAME")
165
           cfn (symbolicate name "-COMPARE")
166
           ccreate (symbolicate "CREATE-" name "-COMPARATOR"))
167
     `(progn
168
        (define-alien-callable ,cname c-string () (string ',name))
169
        (define-compare-function ,cfn ,@compare)
170
        (defun ,ccreate ()
171
          (rocksdb-comparator-create ,state 
172
                                     (alien-sap (alien-callable-function ',destructor))
173
                                     (alien-sap (alien-callable-function ',cfn))
174
                                     (alien-sap (alien-callable-function ',cname)))))))
175
 
176
 (defmacro define-comparator-with-ts (name &key state compare compare-ts compare-without-ts (destructor 'rocksdb-destructor))
177
   "Define a RocksDB Comparator which is timestamp-aware."
178
   (with-gensyms (cname-ts cfn cfn-ts cfn-without-ts ccreate-ts)
179
     (setf cname-ts (symbolicate name "-COMPARATOR-WITH-TS-NAME")
180
           cfn (symbolicate name "-COMPARE")
181
           cfn-ts (symbolicate name "-COMPARE-TS")
182
           cfn-without-ts (symbolicate name "-COMPARE-WITHOUT-TS")
183
           ccreate-ts (symbolicate "CREATE-" name "-COMPARATOR-WITH-TS"))
184
     `(progn
185
        (define-comparator ,name :compare ,compare :destructor ,destructor :state ,state)
186
        (define-alien-callable ,cname-ts c-string () (string ',(symbolicate name "-TS")))
187
        (define-compare-ts-function ,cfn-ts ,@compare-ts)
188
        (define-compare-without-ts-function ,cfn-without-ts ,@compare-without-ts)
189
        (defun ,ccreate-ts ()
190
          (rocksdb-comparator-with-ts-create ,state
191
                                             (alien-sap (alien-callable-function ',destructor))
192
                                             (alien-sap (alien-callable-function ',cfn))
193
                                             (alien-sap (alien-callable-function ',cfn-ts))
194
                                             (alien-sap (alien-callable-function ',cfn-without-ts))
195
                                             (alien-sap (alien-callable-function ',cname-ts)))))))
196
 
197
 ;;; Compaction Filter
198
 (defmacro define-filter-function (name &body body)
199
   `(define-alien-callable ,name unsigned-char
200
        ((state (* t))
201
         (level int)
202
         (key (array unsigned-char))
203
         (key-length size-t)
204
         (existing-val (array unsigned-char))
205
         (existing-val-length size-t)
206
         (new-val (* (array unsigned-char)))
207
         (new-val-length (* size-t))
208
         (value-changed (* unsigned-char)))
209
      ,@body))
210
 
211
 (defmacro define-create-filter-function (name destructor-fn filter-fn name-fn)
212
   `(define-alien-callable ,name (* rocksdb-compactionfilter)
213
        ((state (* t))
214
         (context (* rocksdb-compactionfiltercontext)))
215
      (rocksdb-compactionfilter-create state 
216
                                       (alien-sap (alien-callable-function ',destructor-fn))
217
                                       (alien-sap (alien-callable-function ',filter-fn))
218
                                       (alien-sap (alien-callable-function ',name-fn)))))
219
 
220
 (defmacro define-compaction-filter (name &key (destructor 'rocksdb-destructor)
221
                                               filter)
222
   (with-gensyms (filter-fn cname ccreate)
223
     (setf filter-fn (symbolicate name "-FILTER")
224
           cname (symbolicate name "-COMPACTION-FILTER-NAME")
225
           ccreate (symbolicate "CREATE-" name "COMPACTION-FILTER"))
226
     `(progn
227
        (define-alien-callable ,cname c-string () (string ',name))
228
        (define-filter-function ,filter-fn ,@filter)
229
        (define-create-filter-function ,ccreate
230
            (alien-sap (alien-callable-function ',destructor))
231
          (alien-sap (alien-callable-function ',filter-fn))
232
          (alien-sap (alien-callable-function ',cname))))))
233
 
234
 ;;; Writebatch
235
 (defmacro define-put-function (name &body body)
236
   `(define-alien-callable ,name void
237
        ((state (* t))
238
         (key (array unsigned-char))
239
         (klen size-t)
240
         (val (array unsigned-char))
241
         (vlen size-t))
242
      ,@body))
243
 
244
 (defmacro define-delete-function (name &body body)
245
   `(define-alien-callable ,name void
246
        ((state (* t))
247
         (key (array unsigned-char))
248
         (klen size-t))
249
      ,@body))
250
 
251
 (defmacro define-put-cf-function (name &body body)
252
   `(define-alien-callable ,name void
253
        ((state (* t))
254
         (idx (unsigned 32))
255
         (key (array unsigned-char))
256
         (klen size-t)
257
         (val (array unsigned-char))
258
         (vlen size-t))
259
      ,@body))
260
 
261
 (defmacro define-delete-cf-function (name &body body)
262
   `(define-alien-callable ,name void
263
        ((state (* t))
264
         (idx (unsigned 32))
265
         (key (array unsigned-char))
266
         (klen size-t))
267
      ,@body))
268
 
269
 (defmacro define-merge-cf-function (name &body body)
270
   `(define-alien-callable ,name void
271
        ((state (* t))
272
         (idx (unsigned 32))
273
         (key (array unsigned-char))
274
         (klen size-t)
275
         (val (array unsigned-char))
276
         (vlen size-t))
277
      ,@body))
278
 
279
 (defmacro define-get-ts-function (name &body body)
280
   `(define-alien-callable ,name size-t
281
        ((state (* t))
282
         (ts (unsigned 32)))
283
      ,@body))
284
 
285
 (defmacro with-writebatch ((wb &key rep (destroy t)) &body body)
286
   `(let ((,wb ,@(if rep `((rocksdb-writebatch-create-from ,rep ,(length rep)))
287
                     `((rocksdb-writebatch-create)))))
288
      ,@(if destroy
289
            `((unwind-protect (progn ,@body)
290
                (rocksdb-writebatch-destroy ,wb)))
291
            body)))
292
 
293
 (defmacro with-rocksdb-wbwi ((wbwi &key (reserved 0)
294
                                         (overwrite 0)
295
                                         rep 
296
                                         backup-comparator 
297
                                         max 
298
                                         key-protection-bytes 
299
                                         (destroy t))
300
                              &body body)
301
   `(let ((,wbwi ,@(if rep 
302
                       `((rocksdb-writebatch-wi-create-from ,rep ,(length rep)))
303
                       (if max ;; if any 'param' is present assume they all are
304
                           `((rocksdb-writebatch-wi-create-with-params
305
                              ,backup-comparator ,reserved ,overwrite ,max ,key-protection-bytes))
306
                           `((rocksdb-writebatch-wi-create ,reserved ,overwrite))))))
307
      ,@(if destroy
308
            `((unwind-protect (progn ,@body)
309
                (rocksdb-writebatch-wi-destroy ,wbwi)))
310
            body)))