Adding upstream version 2.2.40.upstream/2.2.40

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

1 files changed, 148 insertions, 0 deletions

diff --git a/tests/gpgscm/ffi-private.h b/tests/gpgscm/ffi-private.h
new file mode 100644
index 0000000..037da56
--- /dev/null
+++ b/tests/gpgscm/ffi-private.h
@@ -0,0 +1,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 */