lsp-alsa/import-api.lsp

   1 ;; This module provides "import extension" functions in support of
   2 ;; importing libasound functions.
   3
   4 ;; Function: (get-string-safe ADDR)
   5 ; Invoke get-string unless ADDR is 0 in which case nil is returned.
   6 (define (get-string-safe ADDR)
   7   (when (!= ADDR) (get-string ADDR)))
   8
   9 ;; Macro: (ptr-api FN ARGS [FORMAT [FILTER]])
  10 ; This macro is used to define an API function for an import function
  11 ; <fn> that a) returns an int error code with 0 on success and
  12 ; negative on error, and b) has a * argument for an on-success return
  13 ; value.
  14 ;
  15 ; The given argument list <args> includes a place marker **
  16 ; where the low-level import function has a ** argument for returning
  17 ; a pointer value. The resulting API function wraps the import
  18 ; function so that the ** argument is omitted but that the pointer
  19 ; value is returned.
  20 ;
  21 (define-macro (wrap** FN ARGS (FORMAT "Lu") (FILTER nil))
  22   (let ((UNPACK (list (list 'unpack FORMAT 'DATA) 0)))
  23     (when FILTER (setf UNPACK (list FILTER UNPACK)))
  24     (letex ((UNPACK UNPACK)
  25             (CALL (cons (eval FN) (replace '** (copy ARGS) 'DATA)))
  26             (REST (clean (curry = '**) ARGS))
  27             (FORMAT FORMAT))
  28       ;; redefine FN with wrapper
  29       (constant FN (fn REST
  30                      (let ((DATA (pack FORMAT 0)) (E 0))
  31                        (if (>= (setf E CALL)) UNPACK E)))) )
  32     ))
  33
  34 ; Wrap an import function that returns "int" error code and has a **
  35 ; argument for an actual return data when error code is 0. The
  36 ; import** term looks like an import, but the return type slot holds
  37 ; list of format and filter, and the ** argument is marked as **.
  38 ;
  39 (define (naming x n)
  40   (if (string? x)
  41       (list x (sym (format "__%d" n)))
  42
  43       (= '** x) (list "void*" x) (list x (sym (format "__%d" n)))))
  44
  45 ; The import is wrapped into a lambda for all other arguments, that
  46 ; then returns the ** data or the error code.
  47 (define-macro (import** _LIB FN RET)
  48   (let ((FORMAT "Lu") (FILTER nil) (NAMED '()) (n 0))
  49     (dolist (i (args))
  50       (when (list? i)
  51         (when (and i (string? (i 0))) (setf FORMAT (pop i)))
  52         (when i (setf FILTER (i 0))))
  53       (if (string? i) (push (list i (sym (string "__" n))) NAMED -1)
  54         (push '("void*" **) NAMED -1))
  55       (inc n))
  56     (eval (flat (list 'import _LIB FN RET (map first NAMED))))
  57     (eval (list 'wrap** (sym FN) (map last NAMED) (or FORMAT "Lu") FILTER))
  58     ))
  59
  60 ;======================================================================
  61 ;; Macro: (define-api FN args [format [filter]]
  62 ; define-api is a helper macro to define an API function for a
  63 ; low-level function FN that provides a return value via a ** argument
  64 ; (i.e., a pointer to a pointer variable).
  65 ;
  66 ; The first macro argument, FN, is the symbol name of the low-level
  67 ; function. The APi function gets the same name with "@" added to it.
  68 ;
  69 ; If the second macro argument is a string, then that will
  70 ;
  71 ; This is handled in newlisp by allocating a pointer
  72 ; variable memory block through a (pack "Lu" 0) term as value for a
  73 ; DATA variable, and then pass DATA as the ** argument for the
  74 ; low-level function. Upon the low-level function's successful return,
  75 ; the now assigned memory block assignment is captured through an
  76 ; (unpack "Lu" DATA) term for return as API function value.
  77 ;
  78 ; The first macro argument
  79 ; Helper macro for functions the return pointers via ** arguments.
  80 ;
  81 ; Eg: (define-api foo x DATA y) will define API function foo@ that
  82 ; calls (foo x DATA y) with DATA being a ** argument, and then returns
  83 ; the value of DATA or the error code of foo.
  84 ;
  85 ; With (define-api foo "lf" x DATA y), i.e. a format string as first
  86 ; argument, then that will be used as unpacking format.
  87 ;
  88 ; With (define-api foo (get-string) x DATA y), i.e. a list with a
  89 ; filter function name as first argument, then that will be used as
  90 ; filter for the unpacked data.
  91 ;
  92 ; Both format and filter may be given, in that order.
  93 (define-macro (define-api FN)
  94   (let ((ARGS (args)) (RES '((unpack "Lu" DATA) 0)))
  95     (when (string? (first ARGS))
  96       (setf RES (letex ((FMT (pop ARGS))) '((unpack FMT DATA) 0))))
  97     (when (list? (first ARGS)) (setf RES (list ((pop ARGS) 0) RES)))
  98     (letex ((REAL (cons FN ARGS))
  99             (API (cons (sym (string (term FN) "@"))
 100                        (clean (fn (x) (= (term x) "DATA")) ARGS)))
 101             (RES RES))
 102       (define API
 103         (let ((DATA (pack "Lu" 0)) (R nil) (E 0))
 104           (when (>= (setf E REAL)) (setf R RES))
 105           (or R E))))))
 106
 107 "import-api.lsp"