tests/gpgscm: Foreign objects support for TinySCHEME.

* tests/gpgscm/scheme-private.h (struct cell): Add 'foreign_object'.
(is_foreign_object): New prototype.
(get_foreign_object_{vtable,data}): Likewise.
* tests/gpgscm/scheme.c (enum scheme_types): New type.
(is_foreign_object): New function.
(get_foreign_object_{vtable,data}): Likewise.
(mk_foreign_object): Likewise.
(finalize_cell): Free foreign objects.
(atom2str): Pretty-print foreign objects.
(vtbl): Add new functions.
* tests/gpgscm/scheme.h (struct foreign_object_vtable): New type.
(mk_foreign_object): New prototype.
(struct scheme_interface): Add new functions.

Patch from Thomas Munro,
https://sourceforge.net/p/tinyscheme/patches/13/

Signed-off-by: Justus Winter <[email protected]>

1 files changed, 10 insertions, 0 deletions

diff --git a/tests/gpgscm/scheme.h b/tests/gpgscm/scheme.h
index 4ba2daa76..f4231c474 100644
--- a/tests/gpgscm/scheme.h
+++ b/tests/gpgscm/scheme.h
@@ -118,6 +118,12 @@ typedef struct cell *pointer;
 typedef void * (*func_alloc)(size_t);
 typedef void (*func_dealloc)(void *);
 
+/* table of functions required for foreign objects */
+typedef struct foreign_object_vtable {
+     void (*finalize)(scheme *sc, void *data);
+     void (*to_string)(scheme *sc, char *out, size_t size, void *data);
+} foreign_object_vtable;
+
 /* num, for generic arithmetic */
 typedef struct num {
      char is_fixnum;
@@ -157,6 +163,7 @@ pointer mk_counted_string(scheme *sc, const char *str, int len);
 pointer mk_empty_string(scheme *sc, int len, char fill);
 pointer mk_character(scheme *sc, int c);
 pointer mk_foreign_func(scheme *sc, foreign_func f);
+pointer mk_foreign_object(scheme *sc, const foreign_object_vtable *vtable, void *data);
 void putstr(scheme *sc, const char *s);
 int list_length(scheme *sc, pointer a);
 int eqv(pointer a, pointer b);
@@ -177,6 +184,9 @@ struct scheme_interface {
   pointer (*mk_character)(scheme *sc, int c);
   pointer (*mk_vector)(scheme *sc, int len);
   pointer (*mk_foreign_func)(scheme *sc, foreign_func f);
+  pointer (*mk_foreign_object)(scheme *sc, const foreign_object_vtable *vtable, void *data);
+  const foreign_object_vtable *(*get_foreign_object_vtable)(pointer p);
+  void *(*get_foreign_object_data)(pointer p);
   void (*putstr)(scheme *sc, const char *s);
   void (*putcharacter)(scheme *sc, int c);