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