Coverage report: /home/ellis/comp/core/lib/rdb/macs.lisp

KindCoveredAll%
expression22103 21.4
branch02 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; rdb/macs.lisp --- macros
2
 
3
 ;;; Code:
4
 (in-package :rdb)
5
 
6
 ;;; error handling
7
 (defmacro with-errptr* ((e err &rest params) &body body)
8
   "Bind e to a C pointer which can be used by alien functions, and if an error is
9
 signaled we coerce this pointer to a string and feed it to a condition of name
10
 ERR with initargs PARAMS for the duration of BODY."
11
   `(with-errptr ,e
12
      (handler-bind ((sb-sys:memory-fault-error
13
                       (lambda (c)
14
                         (declare (ignore c))
15
                         (rocksdb-c-error ,e)))
16
                     (error (lambda (c)
17
                              (declare (ignore c))
18
                              (error ,err :message (deref (sap-alien ,e (* c-string))) ,@params))))
19
        (progn ,@body))))
20
 
21
 ;;; opts
22
 
23
 ;; These expand into lookup macros for the pre-defined option GET and SET
24
 ;; functions - for example RDB-OPT-SETTER and RDB-OPT-GETTER.
25
 (macrolet ((%def-opt-finders (name opt)
26
              `(progn 
27
                 (defmacro ,(symbolicate name '-setter) (key)
28
                   `(find-symbol (format nil "~:@(~A-SET-~A~)" ',',opt ,key) :rocksdb))
29
                 (defmacro ,(symbolicate name '-getter) (key)
30
                   `(find-symbol (format nil "~:@(~A-GET-~A~)" ',',opt ,key) :rocksdb)))))
31
   (%def-opt-finders rdb-opt rocksdb-options)
32
   (%def-opt-finders rdb-writeopt rocksdb-writeoptions)
33
   (%def-opt-finders rdb-readopt rocksdb-readoptions)
34
   (%def-opt-finders rdb-compactopt rocksdb-compactoptions)
35
   (%def-opt-finders rdb-ingestopt rocksdb-ingestexternalfileoptions)
36
   (%def-opt-finders rdb-backupopt rocksdb-backup-engine-options))
37
 
38
 ;;; rdb
39
 ;; these functions only apply to the low-level API in RDB/OBJ (structs only)
40
 (defmacro with-open-rdb-raw ((db-var db-path &optional (opt (default-rocksdb-options))) &body body)
41
   `(let ((,db-var (open-db-raw ,db-path ,opt)))
42
      (unwind-protect (progn ,@body)
43
        (rocksdb-close ,db-var)
44
        (with-errptr* (err 'rocksdb-alien-error)
45
          (rocksdb-options-destroy ,opt)))))
46
 
47
 (defmacro with-rdb ((db-var db &key open close) &body body)
48
   "Bind DB-VAR to the database object DB for the lifetime of BODY."
49
   `(let ((,db-var ,db))
50
      ,@(when open `(open-db ,db-var))
51
      ,@(if close `(unwind-protect (progn ,@body) (close-db ,db-var))
52
            body)))
53
 
54
 ;; temp-rdb
55
 (defvar *temp-db-path-generator*
56
   (lambda (&optional (name "temp-db"))
57
     (make-pathname :directory "tmp" :name (symbol-name (gensym name))))
58
   "A single arg function returning the absolute path to a temp-db path.")
59
 
60
 (defvar *temp-db-destroy* nil)
61
 
62
 ;;; cf
63
 (defmacro with-column ((cf-var cf) &body body)
64
   "Bind CF to CF-VAR for the lifetime of BODY."
65
   `(let ((,cf-var ,cf))
66
      (handler-bind ((error (lambda (condition)
67
                              (error 'cf-error
68
                                     :message
69
                                     (format nil "WITH-COLUMN signaled: ~A" condition)))))
70
        ,@body)))
71
 
72
 (defmacro do-columns ((cf cfs) &body body)
73
   "Do BODY for each CF in the array CFS."
74
   (with-gensyms (%cf)
75
     `(loop for ,%cf across ,cfs
76
            do (with-column (,cf ,%cf) ,@body))))
77
 
78
 ;;; kv
79
 (defmacro with-kv ((k v kv) &body body)
80
   `(let ((,k (kv-key ,kv))
81
          (,v (kv-val ,kv)))
82
      ,@body))
83
 
84
 (defmacro do-kvs ((k v kvs) &body body)
85
   "Do BODY for each K and V in the array KVS."
86
   (with-gensyms (%kv)
87
     `(loop for ,%kv across ,kvs
88
            do (with-kv (,k ,v ,%kv) ,@body))))
89
 
90
 ;; TODO: sb-ext:with-current-source-form ?
91
 ;;; backup
92
 (defmacro with-open-backup-engine-raw ((be-var be-path &optional (opt (rocksdb-options-create)))
93
                                        &body body)
94
   `(let ((,be-var (open-backup-engine-raw ,be-path ,opt)))
95
      (unwind-protect (progn ,@body)
96
        (rocksdb-backup-engine-close ,be-var))))
97
 
98
 ;;; raw
99
 ;; Following macros introduce four anaphors - %KEY and %KLEN and if VAL is present, %VAL and %VLEN.
100
 (defmacro with-kv-raw ((db key eptr &key (error 'kv-error) val cf) &body body)
101
   `(let ((%klen (length ,key))
102
          ,@(when val `((%vlen (length ,val)))))
103
      (with-errptr* (,eptr ',error :db ,db :kv ,(if val `(cons ,key ,val) key) ,@(when cf `(:cf ,cf)))
104
        (with-alien ((%key (* unsigned-char) (make-alien unsigned-char %klen))
105
                     ,@(when val `((%val (* unsigned-char) (make-alien unsigned-char %vlen)))))
106
          (setfa %key ,key)
107
          ,@(when val `((setfa %val ,val)))
108
          ,@body))))
109
 
110
 (defmacro with-kv-raw* (key val &body body)
111
   `(let ((%klen (length ,key))
112
          ,@(when val `((%vlen (length ,val)))))
113
      (with-alien ((%key (* unsigned-char) (make-alien unsigned-char %klen))
114
                   ,@(when val `((%val (* unsigned-char) (make-alien unsigned-char %vlen)))))
115
        (setfa %key ,key)
116
        ,@(when val `((setfa %val ,val)))
117
        ,@body)))
118
 
119
 (defmacro with-txn-raw ((txn eptr &key (error 'txn-error) key val cf db) &body body)
120
   `(let (,@(when key `((%klen (length ,key))))
121
          ,@(when val `((%vlen (length ,val)))))
122
      (with-errptr* (,eptr ',error 
123
                           :txn ,txn
124
                           ,@(when cf `(:cf ,cf))
125
                           ,@(when db `(:db ,db))
126
                           ,@(when (or key val)
127
                               `(:kv ,(if val `(cons ,key ,val) key))))
128
        (with-alien (,@(when key `((%key c-string (cast (make-alien unsigned-char %klen) c-string))))
129
                     ,@(when val `((%val c-string (cast (make-alien unsigned-char %vlen) c-string)))))
130
          ,@(when key `((setfa %key ,key)))
131
          ,@(when val `((setfa %val ,val)))
132
          ,@body))))
133
 
134
 ;;; sst
135
 (defmacro with-sst ((sst &key file comparator destroy) &body body)
136
   "Do BODY with SST bound to a SST-FILE-WRITER. When FILE is supplied
137
 the writer will automatically open that file.
138
 
139
 When COMPARATOR is supplied it is used as the comparator function for
140
 the writer. Every key inserted MUST be in ascending order, according
141
 to the comparator. By default the ordering is binary
142
 lexicographically.
143
 
144
 It is up to the developer to ensure that the comparator used by a
145
 writer is exactly the same as the comparator used when ingesting the
146
 file by a RDB instance."
147
   `(let ((,sst (make-sst-file-writer ,comparator)))
148
      ,@(when file `((open-sst ,sst ,file)))
149
      ,@body
150
      ,@(when destroy `((destroy-sst ,sst)))))
151
 
152
 ;;; opts
153
 (defmacro with-latest-opts (db &body body)
154
   `(progn
155
      (let ((,db (load-opts ,db)))
156
        ,@body)))
157
 
158
 ;;; wbwi
159
 (defmacro with-wbwi ((var &key reserved (overwrite t) (destroy t)) &body body)
160
   `(let ((,var (make-rdb-wbwi :sap (create-wbwi
161
                                     ,(ifret reserved 0)
162
                                     ,(ifret (and overwrite 1) 0)))))
163
      ,@(if destroy
164
            `((unwind-protect (progn ,@body)
165
                (destroy-db ,var)))
166
              body)))