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

KindCoveredAll%
expression735 20.0
branch00nil
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; uring/macs.lisp --- Macros
2
 
3
 ;;
4
 
5
 ;;; Code:
6
 (in-package :uring)
7
 
8
 (defmacro defalien-int (name &body args)
9
   `(progn
10
      (defar ,name int ,@args)
11
      (export '(,name) :uring)))
12
 
13
 (defmacro def-with-ring (name &body args)
14
   `(defalien-int ,name (ring (* io-uring)) ,@args))
15
 
16
 (defvar *io-opcodes* nil)
17
 
18
 (defmacro with-io-sqe ((var val) &body body)
19
   `(with-alien ((,var io-uring-sqe ,val))
20
      ,@body))
21
 
22
 (defmacro with-new-io-sqe (var &body body)
23
   `(with-alien ((,var io-uring-sqe))
24
      ,@body))
25
 
26
 (defmacro with-io-sqe-op ((var op val) &body body)
27
   `(with-io-sqe (,var ,val)
28
      (setf (slot ,var 'opcode) ,op)
29
      ,@body
30
      ,var))
31
 
32
 (defmacro with-new-io-sqe-op ((var op) &body body)
33
   `(with-new-io-sqe ,var
34
      (setf (slot ,var 'opcode) ,op)
35
      ,@body
36
      ,var))
37
 
38
 (defmacro with-io-cqe (var &body body)
39
   `(with-alien ((,var io-uring-cqe))
40
      ,@body))
41
 
42
 (defmacro with-io-uring ((var &optional val) &body body)
43
   `(let ((,var ,(or val (make-alien io-uring))))
44
      ,@body))
45
 
46
 (defmacro with-new-io-uring (var &body body)
47
   `(with-alien ((,var io-uring))
48
      ,@body))
49
 
50
 ;; io_uring_prep_*
51
 (defmacro def-io-op (val name slots &body builder)
52
   "Define a wrapper for an io-uring opcode. This macro will create a
53
 structure class with NAME and SLOTS. BUILDER is the body of the BUILD
54
 method for this struct, with CONST bound to VAR."
55
   (let ((struct-name (symbolicate "IO-OP-" name))
56
         (const-name (symbolicate "+IO-" name "+"))
57
         (alien-name (symbolicate "IORING-OP-" name)))
58
     `(progn
59
        (defconstant ,const-name ,val)
60
        (defstruct ,struct-name ,@slots)
61
        (defmethod build-from ((self ,struct-name) (from system-area-pointer) &key &allow-other-keys)
62
          (with-io-sqe-op (sqe ,const-name (sap-alien from (struct io-uring-sqe)))
63
            ,@builder))
64
        (pushnew ',alien-name *io-opcodes*)
65
        (export '(,struct-name ,(symbolicate "MAKE-" struct-name) ,const-name ,alien-name)))))