changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > core / lisp/ffi/uring/macs.lisp

changeset 698: 96958d3eb5b0
parent: e5ee74cbc4bd
author: Richard Westhaver <ellis@rwest.io>
date: Fri, 04 Oct 2024 22:04:59 -0400
permissions: -rw-r--r--
description: fixes 
     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      (define-alien-routine ,name int ,@args)
    11      (export '(,name) :uring)))
    12 
    13 (defmacro def-with-ring (name &body args)
    14   `(defalien-int ,name (ring (* (struct 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)))))