Coverage report: /home/ellis/comp/core/ffi/uring/prim.lisp

KindCoveredAll%
expression61180 33.9
branch412 33.3
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; uring/prim.lisp --- URING primitives
2
 
3
 ;; Primitive functions related to IO_URING.
4
 
5
 ;;; Commentary:
6
 
7
 ;; These functions operate directly on foreign-allocated types. You
8
 ;; can find all of these in liburing.h. The IOURINGINLINE macro
9
 ;; declares relevant functions as both static and inline. Functions
10
 ;; declarations prefixed by this macro are re-implemented in Lisp
11
 ;; here.
12
 
13
 ;;; Code:
14
 (in-package :uring)
15
 
16
 ;; io-uring-opcode-supported-p
17
 
18
 ;; (sb-alien::sap-int (alien-sap (slot (slot *r1* 'sq) 'khead)))
19
 (defun io-uring-get-sqe (ring)
20
   (let* ((sq (addr (slot ring 'sq)))
21
          (head 0)
22
          (next (1+ (slot sq 'sqe-tail)))
23
          (shift 0))
24
     (when (= 1 (logand (slot ring 'flags) ioring-setup-sqe128))
25
       (setf shift 1))
26
     (if (/= 1 (logand (slot ring 'flags) ioring-setup-sqpoll))
27
         ;; IO_URING_READ_ONCE
28
         (setf head (deref (slot sq 'khead)))
29
         (setf head (slot sq 'khead)))
30
     (when (<= (- next head) (slot sq 'ring-entries))
31
       (prog1
32
           (addr (deref (slot sq 'sqes) (* (alien-size io-uring-sqe) (ash (logand (slot sq 'sqe-tail) (slot sq 'ring-mask)) shift))))
33
         (setf (slot (deref sq) 'sqe-tail) next)
34
         (print (cons head next))))))
35
 
36
 ;; io-uring-cqe-shift
37
 ;; io-uring-cqe-index
38
 
39
 (defmacro io-uring-for-each-cqe (ring head cqe)
40
   ;; todo
41
   )
42
 
43
 (defun io-uring-cq-advance (ring nr)
44
   (when (< 0 nr)
45
     (let* ((cq (addr (slot ring 'cq)))
46
           (head (slot cq 'khead)))
47
       ;; smp-store-release
48
       (setf head (+ nr (deref head))))))
49
 
50
 (defun io-uring-cqe-seen (ring cqe)
51
   (unless (null-alien cqe)
52
     (io-uring-cq-advance ring 1)))
53
 
54
 (defun io-uring-sqe-set-data (sqe data) ;; the C function returns (* void)
55
   (setf (slot sqe 'user-data) data))
56
 
57
 (defun io-uring-cqe-get-data (cqe)
58
   (slot cqe 'user-data))
59
 
60
 (defun io-uring-sqe-set-data64 (sqe data)
61
   "Assign a 64-bit value to this sqe which can be retrieved with
62
 io-uring-cqe-get-data64 instead of a pointer."
63
   (declare (type (unsigned-byte 64) data))
64
   (setf (slot sqe 'user-data) data))
65
 
66
 (defun io-uring-cqe-get-data64 (cqe)
67
   "Same as IO-URING-CQE-GET-DATA but return value is (unsigned-byte 64) value
68
 instead of a pointer."
69
   (slot cqe 'user-data))
70
 
71
 (defun io-uring-sqe-set-flags (sqe flags)
72
   (setf (slot sqe 'flags) flags))
73
 
74
 (defun io-uring-prep-rw (op sqe fd addr len offset)
75
   (setf (slot sqe 'opcode) op
76
         (slot sqe 'flags) 0
77
         (slot sqe 'ioprio) 0
78
         (slot sqe 'fd) fd
79
         (slot sqe 'off-addr-cmd) offset
80
         (slot sqe 'addr-or-splice-off-in) addr
81
         (slot sqe 'len) len
82
         (slot sqe 'flags2) (deref (make-alien io-uring-sqe-slot8))
83
         (slot sqe 'buf-opt) (deref (make-alien io-uring-sqe-slot10))
84
         (slot sqe 'personality) 0
85
         (slot sqe 'splice-index-addr) (deref (make-alien io-uring-sqe-slot12))
86
         (slot sqe 'addr-or-cmd) (deref (make-alien io-uring-sqe-slot13)))
87
   sqe)
88
 
89
 (defun io-uring-prep-splice (sqe fd-in off-in fd-out off-out nbytes splice-flags)
90
   (io-uring-prep-rw +io-splice+ sqe fd-out nil nbytes off-out))
91
 
92
 (defun io-uring-prep-tee (sqe fd-in fd-out nbytes splice-flags)
93
   (io-uring-prep-rw +io-tee+ sqe fd-out nil nbytes 0)
94
   (setf (slot sqe 'splice-off-in) 0)
95
   (setf (slot sqe 'splice-fd-in) fd-in)
96
   (setf (slot sqe 'splice-flags) splice-flags))
97
 
98
 (defun io-uring-prep-readv (sqe fd iovecs nr-vecs offset)
99
   (io-uring-prep-rw +io-readv+ sqe fd iovecs nr-vecs offset))
100
 
101
 (defun io-uring-prep-readv2 (sqe fd iovecs nr-vecs offset flags)
102
   (io-uring-prep-rw +io-readv+ sqe fd iovecs nr-vecs offset)
103
   (setf (slot sqe 'rw-flags) flags))
104
 
105
 ;; ...
106
 
107
 (defun io-uring-prep-nop (sqe)
108
   (io-uring-prep-rw +io-nop+ sqe -1 nil 0 0))
109
 
110
 ;; (with-io-uring (ring)
111
 ;;   (io-uring-queue-init 160 ring 1)
112
 ;;   (io-uring-get-sqe ring))