summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorJustus Winter <justus@g10code.com>2017-03-29 13:45:25 +0200
committerJustus Winter <justus@g10code.com>2017-04-10 14:57:16 +0200
commitd591ab65d37ee467ca91ad851ab236f2985c1ee2 (patch)
tree686272d522b7926833acd227783887e6afc51690 /tests
parentgpgscm: Merge 'opexe_2'. (diff)
downloadgnupg2-d591ab65d37ee467ca91ad851ab236f2985c1ee2.tar.xz
gnupg2-d591ab65d37ee467ca91ad851ab236f2985c1ee2.zip
gpgscm: Merge 'opexe_3'.
* tests/gpgscm/scheme.c (opexe_3): Merge into 'opexe_0'. * tests/gpgscm/opdefines.h: Adapt. -- Having separate functions to execute opcodes reduces our ability to thread the code and prevents the dispatch_table from being moved to rodata. Signed-off-by: Justus Winter <justus@g10code.com>
Diffstat (limited to 'tests')
-rw-r--r--tests/gpgscm/opdefines.h60
-rw-r--r--tests/gpgscm/scheme.c101
2 files changed, 75 insertions, 86 deletions
diff --git a/tests/gpgscm/opdefines.h b/tests/gpgscm/opdefines.h
index bb99698f5..f4e5280e9 100644
--- a/tests/gpgscm/opdefines.h
+++ b/tests/gpgscm/opdefines.h
@@ -106,38 +106,38 @@
_OP_DEF(opexe_0, "vector-length", 1, 1, TST_VECTOR, OP_VECLEN )
_OP_DEF(opexe_0, "vector-ref", 2, 2, TST_VECTOR TST_NATURAL, OP_VECREF )
_OP_DEF(opexe_0, "vector-set!", 3, 3, TST_VECTOR TST_NATURAL TST_ANY, OP_VECSET )
- _OP_DEF(opexe_3, "not", 1, 1, TST_NONE, OP_NOT )
- _OP_DEF(opexe_3, "boolean?", 1, 1, TST_NONE, OP_BOOLP )
- _OP_DEF(opexe_3, "eof-object?", 1, 1, TST_NONE, OP_EOFOBJP )
- _OP_DEF(opexe_3, "null?", 1, 1, TST_NONE, OP_NULLP )
- _OP_DEF(opexe_3, "=", 2, INF_ARG, TST_NUMBER, OP_NUMEQ )
- _OP_DEF(opexe_3, "<", 2, INF_ARG, TST_NUMBER, OP_LESS )
- _OP_DEF(opexe_3, ">", 2, INF_ARG, TST_NUMBER, OP_GRE )
- _OP_DEF(opexe_3, "<=", 2, INF_ARG, TST_NUMBER, OP_LEQ )
- _OP_DEF(opexe_3, ">=", 2, INF_ARG, TST_NUMBER, OP_GEQ )
- _OP_DEF(opexe_3, "symbol?", 1, 1, TST_ANY, OP_SYMBOLP )
- _OP_DEF(opexe_3, "number?", 1, 1, TST_ANY, OP_NUMBERP )
- _OP_DEF(opexe_3, "string?", 1, 1, TST_ANY, OP_STRINGP )
- _OP_DEF(opexe_3, "integer?", 1, 1, TST_ANY, OP_INTEGERP )
- _OP_DEF(opexe_3, "real?", 1, 1, TST_ANY, OP_REALP )
- _OP_DEF(opexe_3, "char?", 1, 1, TST_ANY, OP_CHARP )
+ _OP_DEF(opexe_0, "not", 1, 1, TST_NONE, OP_NOT )
+ _OP_DEF(opexe_0, "boolean?", 1, 1, TST_NONE, OP_BOOLP )
+ _OP_DEF(opexe_0, "eof-object?", 1, 1, TST_NONE, OP_EOFOBJP )
+ _OP_DEF(opexe_0, "null?", 1, 1, TST_NONE, OP_NULLP )
+ _OP_DEF(opexe_0, "=", 2, INF_ARG, TST_NUMBER, OP_NUMEQ )
+ _OP_DEF(opexe_0, "<", 2, INF_ARG, TST_NUMBER, OP_LESS )
+ _OP_DEF(opexe_0, ">", 2, INF_ARG, TST_NUMBER, OP_GRE )
+ _OP_DEF(opexe_0, "<=", 2, INF_ARG, TST_NUMBER, OP_LEQ )
+ _OP_DEF(opexe_0, ">=", 2, INF_ARG, TST_NUMBER, OP_GEQ )
+ _OP_DEF(opexe_0, "symbol?", 1, 1, TST_ANY, OP_SYMBOLP )
+ _OP_DEF(opexe_0, "number?", 1, 1, TST_ANY, OP_NUMBERP )
+ _OP_DEF(opexe_0, "string?", 1, 1, TST_ANY, OP_STRINGP )
+ _OP_DEF(opexe_0, "integer?", 1, 1, TST_ANY, OP_INTEGERP )
+ _OP_DEF(opexe_0, "real?", 1, 1, TST_ANY, OP_REALP )
+ _OP_DEF(opexe_0, "char?", 1, 1, TST_ANY, OP_CHARP )
#if USE_CHAR_CLASSIFIERS
- _OP_DEF(opexe_3, "char-alphabetic?", 1, 1, TST_CHAR, OP_CHARAP )
- _OP_DEF(opexe_3, "char-numeric?", 1, 1, TST_CHAR, OP_CHARNP )
- _OP_DEF(opexe_3, "char-whitespace?", 1, 1, TST_CHAR, OP_CHARWP )
- _OP_DEF(opexe_3, "char-upper-case?", 1, 1, TST_CHAR, OP_CHARUP )
- _OP_DEF(opexe_3, "char-lower-case?", 1, 1, TST_CHAR, OP_CHARLP )
+ _OP_DEF(opexe_0, "char-alphabetic?", 1, 1, TST_CHAR, OP_CHARAP )
+ _OP_DEF(opexe_0, "char-numeric?", 1, 1, TST_CHAR, OP_CHARNP )
+ _OP_DEF(opexe_0, "char-whitespace?", 1, 1, TST_CHAR, OP_CHARWP )
+ _OP_DEF(opexe_0, "char-upper-case?", 1, 1, TST_CHAR, OP_CHARUP )
+ _OP_DEF(opexe_0, "char-lower-case?", 1, 1, TST_CHAR, OP_CHARLP )
#endif
- _OP_DEF(opexe_3, "port?", 1, 1, TST_ANY, OP_PORTP )
- _OP_DEF(opexe_3, "input-port?", 1, 1, TST_ANY, OP_INPORTP )
- _OP_DEF(opexe_3, "output-port?", 1, 1, TST_ANY, OP_OUTPORTP )
- _OP_DEF(opexe_3, "procedure?", 1, 1, TST_ANY, OP_PROCP )
- _OP_DEF(opexe_3, "pair?", 1, 1, TST_ANY, OP_PAIRP )
- _OP_DEF(opexe_3, "list?", 1, 1, TST_ANY, OP_LISTP )
- _OP_DEF(opexe_3, "environment?", 1, 1, TST_ANY, OP_ENVP )
- _OP_DEF(opexe_3, "vector?", 1, 1, TST_ANY, OP_VECTORP )
- _OP_DEF(opexe_3, "eq?", 2, 2, TST_ANY, OP_EQ )
- _OP_DEF(opexe_3, "eqv?", 2, 2, TST_ANY, OP_EQV )
+ _OP_DEF(opexe_0, "port?", 1, 1, TST_ANY, OP_PORTP )
+ _OP_DEF(opexe_0, "input-port?", 1, 1, TST_ANY, OP_INPORTP )
+ _OP_DEF(opexe_0, "output-port?", 1, 1, TST_ANY, OP_OUTPORTP )
+ _OP_DEF(opexe_0, "procedure?", 1, 1, TST_ANY, OP_PROCP )
+ _OP_DEF(opexe_0, "pair?", 1, 1, TST_ANY, OP_PAIRP )
+ _OP_DEF(opexe_0, "list?", 1, 1, TST_ANY, OP_LISTP )
+ _OP_DEF(opexe_0, "environment?", 1, 1, TST_ANY, OP_ENVP )
+ _OP_DEF(opexe_0, "vector?", 1, 1, TST_ANY, OP_VECTORP )
+ _OP_DEF(opexe_0, "eq?", 2, 2, TST_ANY, OP_EQ )
+ _OP_DEF(opexe_0, "eqv?", 2, 2, TST_ANY, OP_EQV )
_OP_DEF(opexe_4, "force", 1, 1, TST_ANY, OP_FORCE )
_OP_DEF(opexe_4, 0, 0, 0, 0, OP_SAVE_FORCED )
_OP_DEF(opexe_4, "write", 1, 2, TST_ANY TST_OUTPORT, OP_WRITE )
diff --git a/tests/gpgscm/scheme.c b/tests/gpgscm/scheme.c
index 31baed235..e3f06de25 100644
--- a/tests/gpgscm/scheme.c
+++ b/tests/gpgscm/scheme.c
@@ -438,7 +438,6 @@ static pointer reverse_in_place(scheme *sc, pointer term, pointer list);
static pointer revappend(scheme *sc, pointer a, pointer b);
static void dump_stack_mark(scheme *);
static pointer opexe_0(scheme *sc, enum scheme_opcodes op);
-static pointer opexe_3(scheme *sc, enum scheme_opcodes op);
static pointer opexe_4(scheme *sc, enum scheme_opcodes op);
static pointer opexe_5(scheme *sc, enum scheme_opcodes op);
static pointer opexe_6(scheme *sc, enum scheme_opcodes op);
@@ -3323,6 +3322,50 @@ set_property(scheme *sc, pointer obj, pointer key, pointer value)
+static int is_list(scheme *sc, pointer a)
+{ return list_length(sc,a) >= 0; }
+
+/* Result is:
+ proper list: length
+ circular list: -1
+ not even a pair: -2
+ dotted list: -2 minus length before dot
+*/
+int list_length(scheme *sc, pointer a) {
+ int i=0;
+ pointer slow, fast;
+
+ slow = fast = a;
+ while (1)
+ {
+ if (fast == sc->NIL)
+ return i;
+ if (!is_pair(fast))
+ return -2 - i;
+ fast = cdr(fast);
+ ++i;
+ if (fast == sc->NIL)
+ return i;
+ if (!is_pair(fast))
+ return -2 - i;
+ ++i;
+ fast = cdr(fast);
+
+ /* Safe because we would have already returned if `fast'
+ encountered a non-pair. */
+ slow = cdr(slow);
+ if (fast == slow)
+ {
+ /* the fast pointer has looped back around and caught up
+ with the slow pointer, hence the structure is circular,
+ not of finite length, and therefore not a list */
+ return -1;
+ }
+ }
+}
+
+
+
#define s_retbool(tf) s_return(sc,(tf) ? sc->T : sc->F)
static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
@@ -3332,6 +3375,7 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
#if USE_MATH
double dd;
#endif
+ int (*comp_func)(num, num) = NULL;
switch (op) {
CASE(OP_LOAD): /* load */
@@ -4506,61 +4550,6 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
s_return(sc,car(sc->args));
}
- default:
- snprintf(sc->strbuff,STRBUFFSIZE,"%d: illegal operator", sc->op);
- Error_0(sc,sc->strbuff);
- }
- return sc->T;
-}
-
-static int is_list(scheme *sc, pointer a)
-{ return list_length(sc,a) >= 0; }
-
-/* Result is:
- proper list: length
- circular list: -1
- not even a pair: -2
- dotted list: -2 minus length before dot
-*/
-int list_length(scheme *sc, pointer a) {
- int i=0;
- pointer slow, fast;
-
- slow = fast = a;
- while (1)
- {
- if (fast == sc->NIL)
- return i;
- if (!is_pair(fast))
- return -2 - i;
- fast = cdr(fast);
- ++i;
- if (fast == sc->NIL)
- return i;
- if (!is_pair(fast))
- return -2 - i;
- ++i;
- fast = cdr(fast);
-
- /* Safe because we would have already returned if `fast'
- encountered a non-pair. */
- slow = cdr(slow);
- if (fast == slow)
- {
- /* the fast pointer has looped back around and caught up
- with the slow pointer, hence the structure is circular,
- not of finite length, and therefore not a list */
- return -1;
- }
- }
-}
-
-static pointer opexe_3(scheme *sc, enum scheme_opcodes op) {
- pointer x;
- num v;
- int (*comp_func)(num,num)=0;
-
- switch (op) {
CASE(OP_NOT): /* not */
s_retbool(is_false(car(sc->args)));
CASE(OP_BOOLP): /* boolean? */