tests/gpgscm: Add a TinySCHEME-based test driver.
[gnupg.git] / 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 <http://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_list(SC, X)  (X)
37 #define CONVERSION_bool(SC, X)  ffi_bool_value ((SC), (X))
38 #define CONVERSION_path(SC, X)  (((SC)->vptr->is_string (X)       \
39                                   ? (SC)->vptr->string_value      \
40                                   : (SC)->vptr->symname) (X))
41
42 #define IS_A_number(SC, X)      (SC)->vptr->is_number (X)
43 #define IS_A_string(SC, X)      (SC)->vptr->is_string (X)
44 #define IS_A_list(SC, X)        (SC)->vptr->is_list ((SC), X)
45 #define IS_A_bool(SC, X)        ((X) == (SC)->F || (X) == (SC)->T)
46 #define IS_A_path(SC, X)        ((SC)->vptr->is_string (X)      \
47                                  || (SC)->vptr->is_symbol (X))
48
49 #define FFI_ARG_OR_RETURN(SC, CTYPE, TARGET, WANT, ARGS)                \
50   do {                                                                  \
51   if ((ARGS) == (SC)->NIL)                                              \
52     return (SC)->vptr->mk_string ((SC),                                 \
53                                   "too few arguments: want "            \
54                                   #TARGET "("#WANT"/"#CTYPE")\n");      \
55   if (! IS_A_##WANT ((SC), pair_car (ARGS))) {                          \
56     char ffi_error_message[256];                                        \
57     snprintf (ffi_error_message, sizeof ffi_error_message,              \
58               "argument %d must be: " #WANT "\n", ffi_arg_index);       \
59     return  (SC)->vptr->mk_string ((SC), ffi_error_message);            \
60   }                                                                     \
61   TARGET = CONVERSION_##WANT (SC, pair_car (ARGS));                     \
62   ARGS = pair_cdr (ARGS);                                               \
63   ffi_arg_index += 1;                                                   \
64   } while (0)
65
66 #define FFI_ARGS_DONE_OR_RETURN(SC, ARGS)                               \
67   do {                                                                  \
68   if ((ARGS) != (SC)->NIL)                                              \
69     return (SC)->vptr->mk_string ((SC), "too many arguments");          \
70   } while (0)
71
72 #define FFI_RETURN_ERR(SC, ERR)                                 \
73   return _cons ((SC), mk_integer ((SC), (ERR)), (SC)->NIL, 1)
74
75 #define FFI_RETURN(SC)  FFI_RETURN_ERR (SC, err)
76
77 #define FFI_RETURN_POINTER(SC, X)                                       \
78   return _cons ((SC), mk_integer ((SC), err),                           \
79                 _cons ((SC), (X), (SC)->NIL, 1), 1)
80 #define FFI_RETURN_INT(SC, X)                                           \
81   FFI_RETURN_POINTER ((SC), mk_integer ((SC), (X)))
82 #define FFI_RETURN_STRING(SC, X)                        \
83   FFI_RETURN_POINTER ((SC), mk_string ((SC), (X)))
84
85 const char *ffi_schemify_name (const char *s, int macro);
86
87 void ffi_scheme_eval (scheme *sc, const char *format, ...)
88   GPGRT_ATTR_PRINTF (2, 3);
89 pointer ffi_sprintf (scheme *sc, const char *format, ...)
90   GPGRT_ATTR_PRINTF (2, 3);
91
92 #define ffi_define_function_name(SC, NAME, F)                           \
93   do {                                                                  \
94     scheme_define ((SC),                                                \
95                    (SC)->global_env,                                    \
96                    mk_symbol ((SC), ffi_schemify_name ("_" #F, 0)),     \
97                    mk_foreign_func ((SC), (do_##F)));                   \
98     ffi_scheme_eval ((SC),                                              \
99                      "(define (%s . a) (ffi-apply \"%s\" %s a))",       \
100                      (NAME), (NAME), ffi_schemify_name ("_" #F, 0));    \
101   } while (0)
102
103 #define ffi_define_function(SC, F)                              \
104   ffi_define_function_name ((SC), ffi_schemify_name (#F, 0), F)
105
106 #define ffi_define_constant(SC, C)                                      \
107   scheme_define ((SC),                                                  \
108                  (SC)->global_env,                                      \
109                  mk_symbol ((SC), ffi_schemify_name (#C, 1)),           \
110                  mk_integer ((SC), (C)))
111
112 #define ffi_define(SC, SYM, EXP)                                        \
113   scheme_define ((SC), (SC)->global_env, mk_symbol ((SC), (SYM)), EXP)
114
115 #define ffi_define_variable_pointer(SC, C, P)                           \
116   scheme_define ((SC),                                                  \
117                  (SC)->global_env,                                      \
118                  mk_symbol ((SC), ffi_schemify_name (#C, 0)),           \
119                  (P))
120
121 #define ffi_define_variable_integer(SC, C)                              \
122   ffi_define_variable_pointer ((SC), C, (SC)->vptr->mk_integer ((SC), C))
123
124 #define ffi_define_variable_string(SC, C)                               \
125   ffi_define_variable_pointer ((SC), C, (SC)->vptr->mk_string ((SC), C ?: ""))
126
127 gpg_error_t ffi_list2argv (scheme *sc, pointer list,
128                            char ***argv, size_t *len);
129 gpg_error_t ffi_list2intv (scheme *sc, pointer list,
130                            int **intv, size_t *len);
131
132 #endif /* GPGSCM_FFI_PRIVATE_H */