contrib/sb-posix/macros.lisp

   1 (in-package :sb-posix-internal)
   2
   3 (define-designator filename c-string
   4   (pathname  (namestring (translate-logical-pathname filename)))
   5   (string filename))
   6
   7 (define-designator file-descriptor (integer 32)
   8   (sb-impl::file-stream (sb-impl::fd-stream-fd file-descriptor))
   9   (fixnum file-descriptor))
  10
  11 (define-designator sap-or-nil sb-sys:system-area-pointer
  12   (null (sb-sys:int-sap 0))
  13   (sb-sys:system-area-pointer sap-or-nil))
  14
  15 (defun lisp-for-c-symbol (s)
  16   (intern (substitute #\- #\_ (string-upcase s)) :sb-posix))
  17
  18 (defmacro define-call (name return-type error-predicate &rest arguments)
  19   (let ((lisp-name (lisp-for-c-symbol name)))
  20     `(progn
  21       (export ',lisp-name :sb-posix)
  22       (declaim (inline ,lisp-name))
  23       (defun ,lisp-name ,(mapcar #'car arguments)
  24         (let ((r (alien-funcall
  25                   (extern-alien
  26                    ,name
  27                    (function ,return-type
  28                              ,@(mapcar
  29                                 (lambda (x)
  30                                   (gethash (cadr x) *designator-types* (cadr x)))
  31                                 arguments)))
  32                   ,@(mapcar (lambda (x)
  33                               (if (nth-value 1 (gethash (cadr x) *designator-types*))
  34                                   `(,(intern (symbol-name (cadr x)) :sb-posix)
  35                                     ,(car x))
  36                                   (car x)))
  37                             arguments))))
  38           (if (,error-predicate r) (syscall-error) r))))))