[Pkg-gnupg-commit] [gnupg2] 16/160: tests/gpgscm: Foreign objects support for TinySCHEME.
Daniel Kahn Gillmor
dkg at fifthhorseman.net
Fri Jul 15 09:36:32 UTC 2016
This is an automated email from the git hooks/post-receive script.
dkg pushed a commit to branch upstream
in repository gnupg2.
commit 56c36f2932fe2baf8e46efdea4315cf33f3c0338
Author: Justus Winter <justus at g10code.com>
Date: Thu Mar 31 13:49:56 2016 +0200
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 <justus at g10code.com>
---
tests/gpgscm/scheme-private.h | 8 ++++++++
tests/gpgscm/scheme.c | 28 +++++++++++++++++++++++++++-
tests/gpgscm/scheme.h | 10 ++++++++++
3 files changed, 45 insertions(+), 1 deletion(-)
diff --git a/tests/gpgscm/scheme-private.h b/tests/gpgscm/scheme-private.h
index 0ddfdbc..9eafe76 100644
--- a/tests/gpgscm/scheme-private.h
+++ b/tests/gpgscm/scheme-private.h
@@ -55,6 +55,10 @@ struct cell {
struct cell *_car;
struct cell *_cdr;
} _cons;
+ struct {
+ char *_data;
+ const foreign_object_vtable *_vtable;
+ } _foreign_object;
} _object;
};
@@ -207,6 +211,10 @@ int is_environment(pointer p);
int is_immutable(pointer p);
void setimmutable(pointer p);
+int is_foreign_object(pointer p);
+const foreign_object_vtable *get_foreign_object_vtable(pointer p);
+void *get_foreign_object_data(pointer p);
+
#ifdef __cplusplus
}
#endif
diff --git a/tests/gpgscm/scheme.c b/tests/gpgscm/scheme.c
index 1f40bb2..748a022 100644
--- a/tests/gpgscm/scheme.c
+++ b/tests/gpgscm/scheme.c
@@ -125,7 +125,8 @@ enum scheme_types {
T_MACRO=12,
T_PROMISE=13,
T_ENVIRONMENT=14,
- T_LAST_SYSTEM_TYPE=14
+ T_FOREIGN_OBJECT=15,
+ T_LAST_SYSTEM_TYPE=15
};
/* ADJ is enough slack to align cells in a TYPE_BITS-bit boundary */
@@ -235,6 +236,14 @@ INTERFACE INLINE pointer closure_env(pointer p) { return cdr(p); }
INTERFACE INLINE int is_continuation(pointer p) { return (type(p)==T_CONTINUATION); }
#define cont_dump(p) cdr(p)
+INTERFACE INLINE int is_foreign_object(pointer p) { return (type(p)==T_FOREIGN_OBJECT); }
+INTERFACE const foreign_object_vtable *get_foreign_object_vtable(pointer p) {
+ return p->_object._foreign_object._vtable;
+}
+INTERFACE void *get_foreign_object_data(pointer p) {
+ return p->_object._foreign_object._data;
+}
+
/* To do: promise should be forced ONCE only */
INTERFACE INLINE int is_promise(pointer p) { return (type(p)==T_PROMISE); }
@@ -930,6 +939,15 @@ pointer mk_foreign_func(scheme *sc, foreign_func f) {
return (x);
}
+pointer mk_foreign_object(scheme *sc, const foreign_object_vtable *vtable, void *data) {
+ pointer x = get_cell(sc, sc->NIL, sc->NIL);
+
+ typeflag(x) = (T_FOREIGN_OBJECT | T_ATOM);
+ x->_object._foreign_object._vtable=vtable;
+ x->_object._foreign_object._data = data;
+ return (x);
+}
+
INTERFACE pointer mk_character(scheme *sc, int c) {
pointer x = get_cell(sc,sc->NIL, sc->NIL);
@@ -1341,6 +1359,8 @@ static void finalize_cell(scheme *sc, pointer a) {
port_close(sc,a,port_input|port_output);
}
sc->free(a->_object._port);
+ } else if(is_foreign_object(a)) {
+ a->_object._foreign_object._vtable->finalize(sc, a->_object._foreign_object._data);
}
}
@@ -2047,6 +2067,9 @@ static void atom2str(scheme *sc, pointer l, int f, char **pp, int *plen) {
snprintf(p,STRBUFFSIZE,"#<FOREIGN PROCEDURE %ld>", procnum(l));
} else if (is_continuation(l)) {
p = "#<CONTINUATION>";
+ } else if (is_foreign_object(l)) {
+ p = sc->strbuff;
+ l->_object._foreign_object._vtable->to_string(sc, p, STRBUFFSIZE, l->_object._foreign_object._data);
} else {
p = "#<ERROR>";
}
@@ -4591,6 +4614,9 @@ static struct scheme_interface vtbl ={
mk_character,
mk_vector,
mk_foreign_func,
+ mk_foreign_object,
+ get_foreign_object_vtable,
+ get_foreign_object_data,
putstr,
putcharacter,
diff --git a/tests/gpgscm/scheme.h b/tests/gpgscm/scheme.h
index 4ba2daa..f4231c4 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);
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-gnupg/gnupg2.git
More information about the Pkg-gnupg-commit
mailing list