Coverage report: /development/source/library/org/datagraph/spocq-shard/src/store/rlmdb/index.lisp

KindCoveredAll%
expression0463 0.0
branch036 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; -*- Mode: lisp; Syntax: ansi-common-lisp; Base: 10; Package: org.datagraph.spocq.implementation; -*-
2
 
3
 (in-package :org.datagraph.rdf.lmdb.implementation)
4
 
5
 ;;; 2020-09-19 modified to no longer map key terms
6
 ;;; uses a quad key for all classes of index database 
7
 
8
 (defgeneric read-index (location database &key quad-pattern filter-p offset limit verbose-p decode class name)
9
   (:method ((location pathname) (database string) &rest args
10
             &key
11
             (class 'rlmdb::quad-database)
12
             (name "spog")
13
             &allow-other-keys)
14
     "Given a location, make a temporary environment with just the meta database and continue."
15
     (let ((env (lmdb:make-environment location)))
16
       (lmdb:with-environment (env)
17
         (lmdb:with-transaction ((txn (lmdb:make-transaction env)))
18
           (let ((db (lmdb:make-database database :class class :name name)))
19
             (apply #'read-index env db args))))))
20
 
21
   (:method ((env lmdb:environment) (db rlmdb::index-database) &key (quad-pattern (make-array 4 :initial-element 0)) (filter-p t)
22
             (offset 0) (limit nil) (verbose-p nil) decode class name)
23
     (declare (ignore class name))
24
     (lmdb:ensure-open-database db)
25
     (let* ((cur (lmdb:make-cursor db :transaction lmdb:*transaction*))
26
            (%cursor nil)
27
            (named-only (case (graph quad-pattern)
28
                          ((-2 |urn:dydra|:|named|) t)
29
                          (t nil)))
30
            (wild-pattern-p (wild-quad-pattern-p quad-pattern))
31
            (count 0))
32
       (cffi:with-foreign-objects ((%quad-pattern '(:struct rdfcache::quad))
33
                                   (%key-quad '(:struct rdfcache::quad)))
34
         (quad-to-quad-record quad-pattern %quad-pattern)
35
         (copy-quad-record %quad-pattern %key-quad)
36
         (when verbose-p
37
           (print :initial)
38
           (%print-quad %quad-pattern *trace-output*)
39
           (%print-quad %key-quad *trace-output*))
40
         (lmdb::with-empty-value (raw-key)
41
           (lmdb::with-empty-value (raw-value)
42
             (labels ((get-entry ()
43
                      (when (zerop count)
44
                        (setf (cffi:foreign-slot-value raw-key '(:struct liblmdb:val) 'liblmdb:mv-size) (cffi:make-pointer 16)
45
                              (cffi:foreign-slot-value raw-key '(:struct liblmdb:val) 'liblmdb:mv-data) %key-quad))
46
                      (when verbose-p
47
                        (print :key-pattern)
48
                        (%print-quad %key-quad *trace-output*)
49
                        (%print-quad (cffi:foreign-slot-value raw-key '(:struct liblmdb:val) 'liblmdb:mv-data) *trace-output*))
50
                      (let ((return-code (liblmdb:cursor-get %cursor
51
                                                           raw-key
52
                                                           raw-value
53
                                                           (if (zerop count) :+set-range+ :+next+)
54
                                                           ;(if (zerop count) :+first+ :+next+)
55
                                                           )))
56
                        (alexandria:switch (return-code)
57
                          (0
58
                           (when verbose-p
59
                             (print :key-next)
60
                             (%print-quad %key-quad *trace-output*)
61
                             (%print-vector %key-quad 16 *trace-output*)
62
                             (%print-quad (cffi:foreign-slot-value raw-key '(:struct liblmdb:val) 'liblmdb:mv-data) *trace-output*)
63
                             (%print-vector (cffi:foreign-slot-value raw-key '(:struct liblmdb:val) 'liblmdb:mv-data)
64
                                            (cffi:pointer-address (cffi:foreign-slot-value raw-key '(:struct liblmdb:val) 'liblmdb:mv-size))
65
                                            *trace-output*))
66
                           (funcall decode raw-key raw-value))
67
                          (liblmdb:+notfound+
68
                           nil)
69
                          (t
70
                           (lmdb::unknown-error return-code)))))
71
                      (decode-index-entry (k v)
72
                        (assert (= 16 (cffi:pointer-address (cffi:foreign-slot-value k '(:struct liblmdb:val) 'liblmdb:mv-size)))
73
                                ()
74
                                "key size is invalid: ~s" (cffi:pointer-address (cffi:foreign-slot-value k '(:struct liblmdb:val) 'liblmdb:mv-size)))
75
                        (let ((%index-quad (cffi:foreign-slot-value k '(:struct liblmdb:val) 'liblmdb:mv-data))
76
                              (visibility-count (/ (cffi:pointer-address (cffi:foreign-slot-value v '(:struct liblmdb:val) 'liblmdb:mv-size))
77
                                                   (cffi:foreign-type-size :uint32))))
78
                          (cond ((and named-only (= (cffi:mem-aref %index-quad 'term-id 0) #xffffffff))
79
                                            ;; skip
80
                                            t)
81
                                ((or (not filter-p) wild-pattern-p (%quad-match-p %quad-pattern %index-quad)) ;; iff still in range
82
                                 (list (term-number-record-to-vector %index-quad (make-array 4))
83
                                       (term-number-record-to-quad %index-quad (spocq:make-quad))
84
                                       (%visibility-record-to-vector (cffi:foreign-slot-value v '(:struct liblmdb:val) 'liblmdb:mv-data)
85
                                                                     (make-array visibility-count))))))))
86
               (unless decode
87
                 (setf decode #'decode-index-entry))
88
               (lmdb:with-cursor (cur)
89
                 (setf %cursor (lmdb::handle cur))
90
                 (loop for entry = (get-entry)
91
                   until (or (null entry)
92
                             (and limit
93
                                  (or (null offset) (not (plusp offset)))
94
                                  (minusp (decf limit))))
95
                   do (incf count)
96
                   when (or (null offset) (minusp (decf offset)))
97
                   collect entry)))))))))
98
 
99
 ;;; (read-index #P"/srv/dydra/catalog/repositories/17fbd622-87be-4a0d-9c6b-85338e837103/" "gpos")
100
 ;;; (read-index #P"/srv/dydra/catalog/repositories/17fbd622-87be-4a0d-9c6b-85338e837103/" "gspo" :quad-pattern #(1 0 0 0) ) :filter-p nil) ;#(43851499 0 0 0))
101
 ;;; (read-index #P"/srv/dydra/catalog/repositories/17fbd622-87be-4a0d-9c6b-85338e837103/" "gspo" :quad-pattern #(981 1 999 6565991) ) :filter-p nil) ;#(43851499 0 0 0))
102
 
103
 ;;; (rlmdb.i::read-index #P"/srv/dydra/catalog/repositories/17fbd622-87be-4a0d-9c6b-85338e837103/" "gspo" :quad-pattern #(56668119 0 0 0) ) ;; #(56668119 1 904 56668666) )
104
 ;;; (read-index #P"/srv/dydra/catalog/repositories/17fbd622-87be-4a0d-9c6b-85338e837103/" "gspo" :quad-pattern #(56668119 56668119 438 56668121) :verbose-p t)
105
 ;;; (read-index #P"/srv/dydra/catalog/repositories/17fbd622-87be-4a0d-9c6b-85338e837103/" "gspo" :quad-pattern #(0 981 0 0) ) :filter-p nil) ;#(43851499 0 0 0))
106
 ;;; (read-index #P"/srv/dydra/catalog/repositories/17fbd622-87be-4a0d-9c6b-85338e837103/" "posg" :quad-pattern #(0 981 0 0) :limit 1 :verbose-p t)
107
 ;;; (read-index #P"/srv/dydra/catalog/repositories/17fbd622-87be-4a0d-9c6b-85338e837103/" "gspo" :quad-pattern #(0 0 0 0) :limit 2) :filter-p nil) ;#(43851499 0 0 0))
108
 ;;; (time (dotimes (x 1000) (read-index #P"/srv/dydra/catalog/repositories/17fbd622-87be-4a0d-9c6b-85338e837103/" "gspo" :quad-pattern #(0 981 0 0) :limit 1 :decode #'(lambda (k v) k v t))))
109
 
110
 ;;; nxp/plm
111
 ;;; (time (dotimes (x 1000) (read-index #P"/srv/dydra/catalog/repositories/398c5459-256f-d24d-af52-2b491bdac565/" "gspo" :quad-pattern #(0 0 0 0) :limit 1 :decode #'(lambda (k v) k v t))))
112
 
113
 #|
114
 @100000 x
115
 Evaluation took:
116
   27.793 seconds of real time
117
   27.696707 seconds of total run time (22.010601 user, 5.686106 system)
118
   [ Run times consist of 0.105 seconds GC time, and 27.592 seconds non-GC time. ]
119
   99.65% CPU
120
   97,277,259,931 processor cycles
121
   771,576,384 bytes consed
122
   
123
 NIL
124
 * (sb-profile:report)
125
 WARNING: Function %COMPARE-QUAD has been redefined, so times may be inaccurate.
126
 PROFILE it again to record calls to the new definition.
127
 WARNING:
128
    Function LIBLMDB:CURSOR-GET has been redefined, so times may be inaccurate.
129
 PROFILE it again to record calls to the new definition.
130
 WARNING: Function READ-INDEX has been redefined, so times may be inaccurate.
131
 PROFILE it again to record calls to the new definition.
132
 
133
   seconds  |     gc     |    consed   |   calls   |  sec/call  |  name  
134
 -------------------------------------------------------------
135
     23.529 |      0.105 | 697,913,920 |   200,000 |   0.000118 | READ-INDEX
136
      1.173 |      0.000 |  73,662,464 |   200,000 |   0.000006 | LIBLMDB:CURSOR-GET
137
      0.063 |      0.000 |           0 | 1,100,000 |   0.000000 | %COMPARE-QUAD
138
 -------------------------------------------------------------
139
     24.765 |      0.105 | 771,576,384 | 1,500,000 |            | Total
140
 
141
 in other words, it is not immediately worth while to move the comparison to c.
142
 |#
143
 
144
 
145
 (defgeneric read-index-cross-reference (location database &key offset limit class name)
146
   (:method ((location pathname) (database string) &rest args
147
             &key (class 'rlmdb::quad-database)
148
             (name "spog")
149
             &allow-other-keys)
150
     "Given a location, make a temporary environment with just the meta database and continue."
151
     (let ((env (lmdb:make-environment location)))
152
       (lmdb:with-environment (env)
153
         (lmdb:with-transaction ((txn (lmdb:make-transaction env)))
154
           (let ((db (lmdb:make-database "gpos" :class class :name name)))
155
             (apply #'read-index-cross-reference env db args))))))
156
 
157
   (:method ((env lmdb:environment) (db rlmdb::index-database) &key (offset 0) (limit nil) class name)
158
     (declare (ignore class name))
159
     (lmdb:ensure-open-database db)
160
     (let* ((scan-cursor (lmdb:make-cursor db :transaction lmdb:*transaction*))
161
            (get-cursor (lmdb:make-cursor db :transaction lmdb:*transaction*))
162
            (count 0))
163
       (cffi:with-foreign-objects ((%quad-pattern '(:struct rdfcache::quad))
164
                                   (%key-quad '(:struct rdfcache::quad)))
165
         (quad-to-quad-record #(0 0 0 0) %quad-pattern)
166
         (copy-quad-record %quad-pattern %key-quad)
167
         (print :initial)
168
         (%print-quad %quad-pattern *trace-output*)
169
         (%print-quad %key-quad *trace-output*)
170
         (lmdb::with-empty-value (raw-key)
171
           (lmdb::with-empty-value (raw-value)
172
             (lmdb::with-empty-value (raw-get-value)
173
             (labels ((get-entry ()
174
                      (when (zerop count)
175
                        (setf (cffi:foreign-slot-value raw-key '(:struct liblmdb:val) 'liblmdb:mv-size) (cffi:make-pointer 16)
176
                              (cffi:foreign-slot-value raw-key '(:struct liblmdb:val) 'liblmdb:mv-data) %key-quad))
177
                      (print :key-pattern)
178
                      (%print-quad %key-quad *trace-output*)
179
                      (%print-quad (cffi:foreign-slot-value raw-key '(:struct liblmdb:val) 'liblmdb:mv-data) *trace-output*)
180
                      (let ((return-code (liblmdb:cursor-get (lmdb::handle scan-cursor)
181
                                                           raw-key
182
                                                           raw-value
183
                                                           (if (zerop count) :+first+ :+next+)
184
                                                           )))
185
                        (alexandria:switch (return-code)
186
                          (0
187
                           (print :key-next)
188
                           (%print-quad %key-quad *trace-output*)
189
                           (%print-vector %key-quad 16 *trace-output*)
190
                           (print (cffi:foreign-slot-value raw-key '(:struct liblmdb:val) 'liblmdb:mv-size) *trace-output*)
191
                           (%print-quad (cffi:foreign-slot-value raw-key '(:struct liblmdb:val) 'liblmdb:mv-data) *trace-output*)
192
                           (%print-vector (cffi:foreign-slot-value raw-key '(:struct liblmdb:val) 'liblmdb:mv-data)
193
                                          (cffi:pointer-address (cffi:foreign-slot-value raw-key '(:struct liblmdb:val) 'liblmdb:mv-size))
194
                                          *trace-output*)
195
                           (reread-index-entry raw-key))
196
                          (liblmdb:+notfound+
197
                           nil)
198
                          (t
199
                           (lmdb::unknown-error return-code)))))
200
                      (reread-index-entry (raw-key)
201
                        (print :keyed-get)
202
                        (%print-quad (cffi:foreign-slot-value raw-key '(:struct liblmdb:val) 'liblmdb:mv-data) *trace-output*)
203
                        (%print-vector (cffi:foreign-slot-value raw-key '(:struct liblmdb:val) 'liblmdb:mv-data)
204
                                          (cffi:pointer-address (cffi:foreign-slot-value raw-key '(:struct liblmdb:val) 'liblmdb:mv-size))
205
                                          *trace-output*)
206
                        (let (#+(or) (return-code (liblmdb:cursor-get (lmdb::handle get-cursor)
207
                                                           raw-key
208
                                                           raw-get-value
209
                                                           :+set-range+
210
                                                           ))
211
                                (return-code (liblmdb:get (lmdb::handle lmdb:*transaction*)
212
                                                          (lmdb::handle db)
213
                                                          raw-key
214
                                                          raw-get-value
215
                                                          )))
216
                          (alexandria:switch (return-code)
217
                            (0 ;; found
218
                             (print :keyed-gotten)
219
                             (%print-quad (cffi:foreign-slot-value raw-key '(:struct liblmdb:val) 'liblmdb:mv-data) *trace-output*)
220
                             (%print-vector (cffi:foreign-slot-value raw-key '(:struct liblmdb:val) 'liblmdb:mv-data)
221
                                            (cffi:pointer-address (cffi:foreign-slot-value raw-key '(:struct liblmdb:val) 'liblmdb:mv-size))
222
                                            *trace-output*)
223
                             (decode-index-entry raw-key raw-get-value))
224
                            (liblmdb:+notfound+
225
                             (print :not-found)
226
                             nil)
227
                            (t
228
                             (lmdb::unknown-error return-code)))))
229
                      (decode-index-entry (k v)
230
                        (declare (ignore v))
231
                        (let ((%index-quad (cffi:foreign-slot-value k '(:struct liblmdb:val) 'liblmdb:mv-data)))
232
                          (assert (= 16 (cffi:pointer-address (cffi:foreign-slot-value k '(:struct liblmdb:val) 'liblmdb:mv-size)))
233
                                  ()
234
                                  "key size is invalid: ~s" (cffi:pointer-address (cffi:foreign-slot-value k '(:struct liblmdb:val) 'liblmdb:mv-size)))
235
                          (list (term-number-record-to-vector %index-quad (make-array 4))
236
                                (term-number-record-to-quad %index-quad (spocq:make-quad))))))
237
             (lmdb:with-cursor (scan-cursor)
238
               (lmdb:with-cursor (get-cursor)
239
               (loop for entry = (get-entry)
240
                 until (or (null entry)
241
                           (and limit
242
                                (or (null offset) (not (plusp offset)))
243
                                (minusp (decf limit))))
244
                 do (incf count)
245
                 when (or (null offset) (minusp (decf offset)))
246
                 collect entry)))))))))))
247
 
248
 ;;; (read-index-cross-reference #P"/srv/dydra/catalog/repositories/17fbd622-87be-4a0d-9c6b-85338e837103/" "gspo" :limit 3 )
249
 
250
 (defgeneric count-index (location database &key quad-pattern class name)
251
   (:method ((location pathname) (database string) &rest args
252
             &key (class 'rlmdb::quad-database)
253
             (name "spog")
254
             &allow-other-keys)
255
     "Given a location, make a temporary environment with just the meta database and continue."
256
     (let ((env (lmdb:make-environment location)))
257
       (lmdb:with-environment (env)
258
         (lmdb:with-transaction ((txn (lmdb:make-transaction env)))
259
           (let ((db (lmdb:make-database "gpos" :class class :name name)))
260
             (apply #'count-index env db args))))))
261
 
262
   (:method ((env lmdb:environment) (db rlmdb::index-database) &key (quad-pattern (make-array 4 :initial-element 0)) class name)
263
     (declare (optimize (speed 3) (safety 0))
264
              (ftype (function (SB-SYS:SYSTEM-AREA-POINTER SB-SYS:SYSTEM-AREA-POINTER SB-SYS:SYSTEM-AREA-POINTER keyword) fixnum) liblmdb:cursor-get)
265
              (ignore class name))
266
     (lmdb:ensure-open-database db)
267
     (let* ((cur (lmdb:make-cursor db :transaction lmdb:*transaction*))
268
            (%cursor nil)
269
            (count 0))
270
       (cffi:with-foreign-objects ((%quad-pattern '(:struct rdfcache::quad))
271
                                   (%key-quad '(:struct rdfcache::quad)))
272
         (quad-to-quad-record quad-pattern %quad-pattern)
273
         (copy-quad-record %quad-pattern %key-quad)
274
         (lmdb::with-empty-value (raw-key)
275
           (lmdb::with-empty-value (raw-value)
276
             (lmdb:with-cursor (cur)
277
               (setf %cursor (lmdb::handle cur))
278
               (loop while (let ((return-code (liblmdb:cursor-get %cursor
279
                                                                  raw-key
280
                                                                  raw-value
281
                                                                  (if (zerop count) :+first+ :+next+)
282
                                                                  )))
283
                             (alexandria:switch (return-code)
284
                                                (0
285
                                                 t)
286
                                                (liblmdb:+notfound+
287
                                                 nil)
288
                                                (t
289
                                                 (lmdb::unknown-error return-code))))
290
                 do (incf count))))))
291
       count)))
292
 
293
 
294
 ;;; performance micro-benchmarks
295
 ;;; (time (count-index #P"/srv/dydra/catalog/repositories/398c5459-256f-d24d-af52-2b491bdac565/" "gspo" :quad-pattern #(0 0 0 0)))
296
 #|
297
 ;; count-index (that is w/ffi)
298
 Evaluation took:
299
   1.682 seconds of real time
300
   1.680950 seconds of total run time (1.554457 user, 0.126493 system)
301
   99.94% CPU
302
   5,887,784,294 processor cycles
303
   163,424 bytes consed
304
   
305
 16568543
306
 
307
 ;; straight c implementation
308
 root@stage:/opt/spocq# time ./sample-rlmdb --nocopy
309
 complete: 16568543
310
 
311
 real    0m0.589s
312
 user    0m0.483s
313
 sys     0m0.105s
314
 
315
 ;; rdfcache admin utility
316
 root@stage:/opt/spocq# time dydra-admin count-quads nxp/plm   # warm
317
 16568543
318
 
319
 real    0m1.636s
320
 user    0m0.025s
321
 sys     0m0.057s
322
 root@stage:/opt/spocq# 
323
 |#
324
 
325
 ;;; (time (spocq.i::test-sparql "select (count (?x) as ?count) where { {graph ?g {?x ?p ?o}} union {?x ?p ?o}}" :repository-id "nxp/plm"))
326
 ;;; 1.6x the cpu time, but the same execution
327
 ;;; (time (spocq.i::test-sparql "select (count (?s) as ?count) where {graph ?g {?s ?p ?o}}" :repository-id "nxp/plm"))
328
 #|
329
   5.205 5.187 5.194 seconds of real time
330
   (/ 16568543 (/ (+ 5.205 5.187 5.194) 3)) = 3189120.3/sec
331
 
332
 this compares to the results from the 2017-05-27 core, which uses the dydra-ndk interface
333
   12.525 11.210 seconds of real time 
334
   (/ 16568543 (/ (+ 12.525 11.210) 2)) = 1396127.5/sec
335
 |#
336
 (defgeneric count-index-flet (location database &key quad-pattern test class name)
337
   (:method ((location pathname) (database string) &rest args
338
             &key (class 'rlmdb::quad-database)
339
             (name "spog")
340
             &allow-other-keys)
341
     "Given a location, make a temporary environment with just the meta database and continue."
342
     (let ((env (lmdb:make-environment location)))
343
       (lmdb:with-environment (env)
344
         (lmdb:with-transaction ((txn (lmdb:make-transaction env)))
345
           (let ((db (lmdb:make-database "gpos" :class class :name name)))
346
             (apply #'count-index-flet env db args))))))
347
 
348
   (:method ((env lmdb:environment) (db rlmdb::index-database) &key (quad-pattern (make-array 4 :initial-element 0))
349
             (test #'(lambda (k v) k v t)) class name)
350
     (declare (type (function (SB-SYS:SYSTEM-AREA-POINTER SB-SYS:SYSTEM-AREA-POINTER) boolean) test)
351
              (optimize (speed 3) (safety 0))
352
              (ignore class name))
353
     (assert (functionp test))
354
              
355
     (lmdb:ensure-open-database db)
356
     (let* ((cur (lmdb:make-cursor db :transaction lmdb:*transaction*))
357
            (%cursor nil)
358
            (count 0))
359
       (cffi:with-foreign-objects ((%quad-pattern '(:struct rdfcache::quad))
360
                                   (%key-quad '(:struct rdfcache::quad)))
361
         (quad-to-quad-record quad-pattern %quad-pattern)
362
         (copy-quad-record %quad-pattern %key-quad)
363
         (lmdb::with-empty-value (raw-key)
364
           (lmdb::with-empty-value (raw-value)
365
             (labels ((get-entry ()
366
                        (let ((return-code (liblmdb:cursor-get %cursor
367
                                                               raw-key
368
                                                               raw-value
369
                                                               (if (zerop count) :+first+ :+next+)
370
                                                               )))
371
                          (alexandria:switch (return-code)
372
                                             (0
373
                                              (funcall test raw-key raw-value)
374
                                              )
375
                                             (liblmdb:+notfound+
376
                                              nil)
377
                                             (t
378
                                              (lmdb::unknown-error return-code))))))
379
               (lmdb:with-cursor (cur)
380
                 (setf %cursor (lmdb::handle cur))
381
                 (loop for entry = (get-entry)
382
                   until (null entry)
383
                   do (incf count)))))))
384
       count)))
385
 
386
 #+(or)
387
 (progn
388
   (time (count-index-flet #P"/srv/dydra/catalog/repositories/398c5459-256f-d24d-af52-2b491bdac565/" "gspo" :quad-pattern #(0 0 0 0)
389
                           :test #'(lambda (k v) k v t)))
390
   )
391