security-and-privacy/gnupg
security-and-privacy/gnupg
1
0
Fork 0
mirror of git://git.gnupg.org/gnupg.git synced 2025-07-02 22:46:30 +02:00
Code Activity

tests/gpgscm: Foreign objects support for TinySCHEME.

Browse source 
* 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@g10code.com>
This commit is contained in:
Justus Winter 2016-03-31 13:49:56 +02:00
parent 8e5ad9aabd
commit 56c36f2932
3 changed files with 45 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

28
tests/gpgscm/scheme.c
View file

@ -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,