tests/gpgscm/ffi-private.h

   1 /* FFI interface for TinySCHEME.
   2  *
   3  * Copyright (C) 2016 g10 code GmbH
   4  *
   5  * This file is part of GnuPG.
   6  *
   7  * GnuPG is free software; you can redistribute it and/or modify
   8  * it under the terms of the GNU General Public License as published by
   9  * the Free Software Foundation; either version 3 of the License, or
  10  * (at your option) any later version.
  11  *
  12  * GnuPG is distributed in the hope that it will be useful,
  13  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  14  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15  * GNU General Public License for more details.
  16  *
  17  * You should have received a copy of the GNU General Public License
  18  * along with this program; if not, see <https://www.gnu.org/licenses/>.
  19  */
  20
  21 #ifndef GPGSCM_FFI_PRIVATE_H
  22 #define GPGSCM_FFI_PRIVATE_H
  23
  24 #include <gpg-error.h>
  25 #include "scheme.h"
  26 #include "scheme-private.h"
  27
  28 #define FFI_PROLOG()                                            \
  29   unsigned int ffi_arg_index GPGRT_ATTR_UNUSED = 1;             \
  30   int err GPGRT_ATTR_UNUSED = 0                                 \
  31
  32 int ffi_bool_value (scheme *sc, pointer p);
  33
  34 #define CONVERSION_number(SC, X) (SC)->vptr->ivalue (X)
  35 #define CONVERSION_string(SC, X) (SC)->vptr->string_value (X)
  36 #define CONVERSION_character(SC, X) (SC)->vptr->charvalue (X)
  37 #define CONVERSION_list(SC, X)  (X)
  38 #define CONVERSION_bool(SC, X)  ffi_bool_value ((SC), (X))
  39 #define CONVERSION_path(SC, X)  (((SC)->vptr->is_string (X)       \
  40                                   ? (SC)->vptr->string_value      \
  41                                   : (SC)->vptr->symname) (X))
  42
  43 #define IS_A_number(SC, X)      (SC)->vptr->is_number (X)
  44 #define IS_A_string(SC, X)      (SC)->vptr->is_string (X)
  45 #define IS_A_character(SC, X)   (SC)->vptr->is_character (X)
  46 #define IS_A_list(SC, X)        (SC)->vptr->is_list ((SC), X)
  47 #define IS_A_bool(SC, X)        ((X) == (SC)->F || (X) == (SC)->T)
  48 #define IS_A_path(SC, X)        ((SC)->vptr->is_string (X)      \
  49                                  || (SC)->vptr->is_symbol (X))
  50
  51 #define FFI_ARG_OR_RETURN(SC, CTYPE, TARGET, WANT, ARGS)                \
  52   do {                                                                  \
  53   if ((ARGS) == (SC)->NIL)                                              \
  54     return (SC)->vptr->mk_string ((SC),                                 \
  55                                   "too few arguments: want "            \
  56                                   #TARGET "("#WANT"/"#CTYPE")\n");      \
  57   if (! IS_A_##WANT ((SC), pair_car (ARGS))) {                          \
  58     char ffi_error_message[256];                                        \
  59     snprintf (ffi_error_message, sizeof ffi_error_message,              \
  60               "argument %d must be: " #WANT "\n", ffi_arg_index);       \
  61     return  (SC)->vptr->mk_string ((SC), ffi_error_message);            \
  62   }                                                                     \
  63   TARGET = CONVERSION_##WANT (SC, pair_car (ARGS));                     \
  64   ARGS = pair_cdr (ARGS);                                               \
  65   ffi_arg_index += 1;                                                   \
  66   } while (0)
  67
  68 #define FFI_ARGS_DONE_OR_RETURN(SC, ARGS)                               \
  69   do {                                                                  \
  70   if ((ARGS) != (SC)->NIL)                                              \
  71     return (SC)->vptr->mk_string ((SC), "too many arguments");          \
  72   } while (0)
  73
  74 #define FFI_RETURN_ERR(SC, ERR)                                 \
  75   return _cons ((SC), mk_integer ((SC), (ERR)), (SC)->NIL, 1)
  76
  77 #define FFI_RETURN(SC)  FFI_RETURN_ERR (SC, err)
  78
  79 #define FFI_RETURN_POINTER(SC, X)                                       \
  80   return _cons ((SC), mk_integer ((SC), err),                           \
  81                 _cons ((SC), (X), (SC)->NIL, 1), 1)
  82 #define FFI_RETURN_INT(SC, X)                                           \
  83   FFI_RETURN_POINTER ((SC), mk_integer ((SC), (X)))
  84 #define FFI_RETURN_STRING(SC, X)                        \
  85   FFI_RETURN_POINTER ((SC), mk_string ((SC), (X)))
  86
  87 char *ffi_schemify_name (const char *s, int macro);
  88
  89 void ffi_scheme_eval (scheme *sc, const char *format, ...)
  90   GPGRT_ATTR_PRINTF (2, 3);
  91 pointer ffi_sprintf (scheme *sc, const char *format, ...)
  92   GPGRT_ATTR_PRINTF (2, 3);
  93
  94 #define ffi_define_function_name(SC, NAME, F)                           \
  95   do {                                                                  \
  96     char *_fname = ffi_schemify_name ("__" #F, 0);                      \
  97     scheme_define ((SC),                                                \
  98                    (SC)->global_env,                                    \
  99                    mk_symbol ((SC), _fname),                            \
 100                    mk_foreign_func ((SC), (do_##F)));                   \
 101     ffi_scheme_eval ((SC),                                              \
 102                      "(define (%s . a) (ffi-apply \"%s\" %s a))",       \
 103                      (NAME), (NAME), _fname);                           \
 104     free (_fname);                                                      \
 105   } while (0)
 106
 107 #define ffi_define_function(SC, F)                                      \
 108   do {                                                                  \
 109     char *_name = ffi_schemify_name (#F, 0);                            \
 110     ffi_define_function_name ((SC), _name, F);                          \
 111     free (_name);                                                       \
 112   } while (0)
 113
 114 #define ffi_define_constant(SC, C)                                      \
 115   do {                                                                  \
 116     char *_name = ffi_schemify_name (#C, 1);                            \
 117     scheme_define ((SC),                                                \
 118                    (SC)->global_env,                                    \
 119                    mk_symbol ((SC), _name),                             \
 120                    mk_integer ((SC), (C)));                             \
 121     free (_name);                                                       \
 122   } while (0)
 123
 124 #define ffi_define(SC, SYM, EXP)                                        \
 125   scheme_define ((SC), (SC)->global_env, mk_symbol ((SC), (SYM)), EXP)
 126
 127 #define ffi_define_variable_pointer(SC, C, P)                           \
 128   do {                                                                  \
 129     char *_name = ffi_schemify_name (#C, 0);                            \
 130     scheme_define ((SC),                                                \
 131                    (SC)->global_env,                                    \
 132                    mk_symbol ((SC), _name),                             \
 133                    (P));                                                \
 134     free (_name);                                                       \
 135   } while (0)
 136
 137 #define ffi_define_variable_integer(SC, C)                              \
 138   ffi_define_variable_pointer ((SC), C, (SC)->vptr->mk_integer ((SC), C))
 139
 140 #define ffi_define_variable_string(SC, C)                               \
 141   ffi_define_variable_pointer ((SC), C, (SC)->vptr->mk_string ((SC), C ?: ""))
 142
 143 gpg_error_t ffi_list2argv (scheme *sc, pointer list,
 144                            char ***argv, size_t *len);
 145 gpg_error_t ffi_list2intv (scheme *sc, pointer list,
 146                            int **intv, size_t *len);
 147
 148 #endif /* GPGSCM_FFI_PRIVATE_H */