mirror of
git://git.gnupg.org/gnupg.git
synced 2024-12-22 10:19:57 +01:00
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>
This commit is contained in:
Justus Winter
parent
6cad38228f
commit
d591ab65d3
@ -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 )
|
||||
|
||||
@ -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? */
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user