mirror of
git://git.gnupg.org/gnupg.git
synced 2024-12-22 10:19:57 +01:00
gpgscm: Merge 'opexe_2'.
* tests/gpgscm/scheme.c (opexe_2): 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:
parent
154af876f0
commit
6cad38228f
@ -59,53 +59,53 @@
|
||||
_OP_DEF(opexe_0, "apply", 1, INF_ARG, TST_NONE, OP_PAPPLY )
|
||||
_OP_DEF(opexe_0, "call-with-current-continuation", 1, 1, TST_NONE, OP_CONTINUATION )
|
||||
#if USE_MATH
|
||||
_OP_DEF(opexe_2, "inexact->exact", 1, 1, TST_NUMBER, OP_INEX2EX )
|
||||
_OP_DEF(opexe_2, "exp", 1, 1, TST_NUMBER, OP_EXP )
|
||||
_OP_DEF(opexe_2, "log", 1, 1, TST_NUMBER, OP_LOG )
|
||||
_OP_DEF(opexe_2, "sin", 1, 1, TST_NUMBER, OP_SIN )
|
||||
_OP_DEF(opexe_2, "cos", 1, 1, TST_NUMBER, OP_COS )
|
||||
_OP_DEF(opexe_2, "tan", 1, 1, TST_NUMBER, OP_TAN )
|
||||
_OP_DEF(opexe_2, "asin", 1, 1, TST_NUMBER, OP_ASIN )
|
||||
_OP_DEF(opexe_2, "acos", 1, 1, TST_NUMBER, OP_ACOS )
|
||||
_OP_DEF(opexe_2, "atan", 1, 2, TST_NUMBER, OP_ATAN )
|
||||
_OP_DEF(opexe_2, "sqrt", 1, 1, TST_NUMBER, OP_SQRT )
|
||||
_OP_DEF(opexe_2, "expt", 2, 2, TST_NUMBER, OP_EXPT )
|
||||
_OP_DEF(opexe_2, "floor", 1, 1, TST_NUMBER, OP_FLOOR )
|
||||
_OP_DEF(opexe_2, "ceiling", 1, 1, TST_NUMBER, OP_CEILING )
|
||||
_OP_DEF(opexe_2, "truncate", 1, 1, TST_NUMBER, OP_TRUNCATE )
|
||||
_OP_DEF(opexe_2, "round", 1, 1, TST_NUMBER, OP_ROUND )
|
||||
_OP_DEF(opexe_0, "inexact->exact", 1, 1, TST_NUMBER, OP_INEX2EX )
|
||||
_OP_DEF(opexe_0, "exp", 1, 1, TST_NUMBER, OP_EXP )
|
||||
_OP_DEF(opexe_0, "log", 1, 1, TST_NUMBER, OP_LOG )
|
||||
_OP_DEF(opexe_0, "sin", 1, 1, TST_NUMBER, OP_SIN )
|
||||
_OP_DEF(opexe_0, "cos", 1, 1, TST_NUMBER, OP_COS )
|
||||
_OP_DEF(opexe_0, "tan", 1, 1, TST_NUMBER, OP_TAN )
|
||||
_OP_DEF(opexe_0, "asin", 1, 1, TST_NUMBER, OP_ASIN )
|
||||
_OP_DEF(opexe_0, "acos", 1, 1, TST_NUMBER, OP_ACOS )
|
||||
_OP_DEF(opexe_0, "atan", 1, 2, TST_NUMBER, OP_ATAN )
|
||||
_OP_DEF(opexe_0, "sqrt", 1, 1, TST_NUMBER, OP_SQRT )
|
||||
_OP_DEF(opexe_0, "expt", 2, 2, TST_NUMBER, OP_EXPT )
|
||||
_OP_DEF(opexe_0, "floor", 1, 1, TST_NUMBER, OP_FLOOR )
|
||||
_OP_DEF(opexe_0, "ceiling", 1, 1, TST_NUMBER, OP_CEILING )
|
||||
_OP_DEF(opexe_0, "truncate", 1, 1, TST_NUMBER, OP_TRUNCATE )
|
||||
_OP_DEF(opexe_0, "round", 1, 1, TST_NUMBER, OP_ROUND )
|
||||
#endif
|
||||
_OP_DEF(opexe_2, "+", 0, INF_ARG, TST_NUMBER, OP_ADD )
|
||||
_OP_DEF(opexe_2, "-", 1, INF_ARG, TST_NUMBER, OP_SUB )
|
||||
_OP_DEF(opexe_2, "*", 0, INF_ARG, TST_NUMBER, OP_MUL )
|
||||
_OP_DEF(opexe_2, "/", 1, INF_ARG, TST_NUMBER, OP_DIV )
|
||||
_OP_DEF(opexe_2, "quotient", 1, INF_ARG, TST_INTEGER, OP_INTDIV )
|
||||
_OP_DEF(opexe_2, "remainder", 2, 2, TST_INTEGER, OP_REM )
|
||||
_OP_DEF(opexe_2, "modulo", 2, 2, TST_INTEGER, OP_MOD )
|
||||
_OP_DEF(opexe_2, "car", 1, 1, TST_PAIR, OP_CAR )
|
||||
_OP_DEF(opexe_2, "cdr", 1, 1, TST_PAIR, OP_CDR )
|
||||
_OP_DEF(opexe_2, "cons", 2, 2, TST_NONE, OP_CONS )
|
||||
_OP_DEF(opexe_2, "set-car!", 2, 2, TST_PAIR TST_ANY, OP_SETCAR )
|
||||
_OP_DEF(opexe_2, "set-cdr!", 2, 2, TST_PAIR TST_ANY, OP_SETCDR )
|
||||
_OP_DEF(opexe_2, "char->integer", 1, 1, TST_CHAR, OP_CHAR2INT )
|
||||
_OP_DEF(opexe_2, "integer->char", 1, 1, TST_NATURAL, OP_INT2CHAR )
|
||||
_OP_DEF(opexe_2, "char-upcase", 1, 1, TST_CHAR, OP_CHARUPCASE )
|
||||
_OP_DEF(opexe_2, "char-downcase", 1, 1, TST_CHAR, OP_CHARDNCASE )
|
||||
_OP_DEF(opexe_2, "symbol->string", 1, 1, TST_SYMBOL, OP_SYM2STR )
|
||||
_OP_DEF(opexe_2, "atom->string", 1, 2, TST_ANY TST_NATURAL, OP_ATOM2STR )
|
||||
_OP_DEF(opexe_2, "string->symbol", 1, 1, TST_STRING, OP_STR2SYM )
|
||||
_OP_DEF(opexe_2, "string->atom", 1, 2, TST_STRING TST_NATURAL, OP_STR2ATOM )
|
||||
_OP_DEF(opexe_2, "make-string", 1, 2, TST_NATURAL TST_CHAR, OP_MKSTRING )
|
||||
_OP_DEF(opexe_2, "string-length", 1, 1, TST_STRING, OP_STRLEN )
|
||||
_OP_DEF(opexe_2, "string-ref", 2, 2, TST_STRING TST_NATURAL, OP_STRREF )
|
||||
_OP_DEF(opexe_2, "string-set!", 3, 3, TST_STRING TST_NATURAL TST_CHAR, OP_STRSET )
|
||||
_OP_DEF(opexe_2, "string-append", 0, INF_ARG, TST_STRING, OP_STRAPPEND )
|
||||
_OP_DEF(opexe_2, "substring", 2, 3, TST_STRING TST_NATURAL, OP_SUBSTR )
|
||||
_OP_DEF(opexe_2, "vector", 0, INF_ARG, TST_NONE, OP_VECTOR )
|
||||
_OP_DEF(opexe_2, "make-vector", 1, 2, TST_NATURAL TST_ANY, OP_MKVECTOR )
|
||||
_OP_DEF(opexe_2, "vector-length", 1, 1, TST_VECTOR, OP_VECLEN )
|
||||
_OP_DEF(opexe_2, "vector-ref", 2, 2, TST_VECTOR TST_NATURAL, OP_VECREF )
|
||||
_OP_DEF(opexe_2, "vector-set!", 3, 3, TST_VECTOR TST_NATURAL TST_ANY, OP_VECSET )
|
||||
_OP_DEF(opexe_0, "+", 0, INF_ARG, TST_NUMBER, OP_ADD )
|
||||
_OP_DEF(opexe_0, "-", 1, INF_ARG, TST_NUMBER, OP_SUB )
|
||||
_OP_DEF(opexe_0, "*", 0, INF_ARG, TST_NUMBER, OP_MUL )
|
||||
_OP_DEF(opexe_0, "/", 1, INF_ARG, TST_NUMBER, OP_DIV )
|
||||
_OP_DEF(opexe_0, "quotient", 1, INF_ARG, TST_INTEGER, OP_INTDIV )
|
||||
_OP_DEF(opexe_0, "remainder", 2, 2, TST_INTEGER, OP_REM )
|
||||
_OP_DEF(opexe_0, "modulo", 2, 2, TST_INTEGER, OP_MOD )
|
||||
_OP_DEF(opexe_0, "car", 1, 1, TST_PAIR, OP_CAR )
|
||||
_OP_DEF(opexe_0, "cdr", 1, 1, TST_PAIR, OP_CDR )
|
||||
_OP_DEF(opexe_0, "cons", 2, 2, TST_NONE, OP_CONS )
|
||||
_OP_DEF(opexe_0, "set-car!", 2, 2, TST_PAIR TST_ANY, OP_SETCAR )
|
||||
_OP_DEF(opexe_0, "set-cdr!", 2, 2, TST_PAIR TST_ANY, OP_SETCDR )
|
||||
_OP_DEF(opexe_0, "char->integer", 1, 1, TST_CHAR, OP_CHAR2INT )
|
||||
_OP_DEF(opexe_0, "integer->char", 1, 1, TST_NATURAL, OP_INT2CHAR )
|
||||
_OP_DEF(opexe_0, "char-upcase", 1, 1, TST_CHAR, OP_CHARUPCASE )
|
||||
_OP_DEF(opexe_0, "char-downcase", 1, 1, TST_CHAR, OP_CHARDNCASE )
|
||||
_OP_DEF(opexe_0, "symbol->string", 1, 1, TST_SYMBOL, OP_SYM2STR )
|
||||
_OP_DEF(opexe_0, "atom->string", 1, 2, TST_ANY TST_NATURAL, OP_ATOM2STR )
|
||||
_OP_DEF(opexe_0, "string->symbol", 1, 1, TST_STRING, OP_STR2SYM )
|
||||
_OP_DEF(opexe_0, "string->atom", 1, 2, TST_STRING TST_NATURAL, OP_STR2ATOM )
|
||||
_OP_DEF(opexe_0, "make-string", 1, 2, TST_NATURAL TST_CHAR, OP_MKSTRING )
|
||||
_OP_DEF(opexe_0, "string-length", 1, 1, TST_STRING, OP_STRLEN )
|
||||
_OP_DEF(opexe_0, "string-ref", 2, 2, TST_STRING TST_NATURAL, OP_STRREF )
|
||||
_OP_DEF(opexe_0, "string-set!", 3, 3, TST_STRING TST_NATURAL TST_CHAR, OP_STRSET )
|
||||
_OP_DEF(opexe_0, "string-append", 0, INF_ARG, TST_STRING, OP_STRAPPEND )
|
||||
_OP_DEF(opexe_0, "substring", 2, 3, TST_STRING TST_NATURAL, OP_SUBSTR )
|
||||
_OP_DEF(opexe_0, "vector", 0, INF_ARG, TST_NONE, OP_VECTOR )
|
||||
_OP_DEF(opexe_0, "make-vector", 1, 2, TST_NATURAL TST_ANY, OP_MKVECTOR )
|
||||
_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 )
|
||||
|
@ -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_2(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);
|
||||
@ -3276,11 +3275,63 @@ history_flatten(scheme *sc)
|
||||
|
||||
|
||||
|
||||
#if USE_PLIST
|
||||
static pointer
|
||||
get_property(scheme *sc, pointer obj, pointer key)
|
||||
{
|
||||
pointer x;
|
||||
|
||||
assert (is_symbol(obj));
|
||||
assert (is_symbol(key));
|
||||
|
||||
for (x = symprop(obj); x != sc->NIL; x = cdr(x)) {
|
||||
if (caar(x) == key)
|
||||
break;
|
||||
}
|
||||
|
||||
if (x != sc->NIL)
|
||||
return cdar(x);
|
||||
|
||||
return sc->NIL;
|
||||
}
|
||||
|
||||
static pointer
|
||||
set_property(scheme *sc, pointer obj, pointer key, pointer value)
|
||||
{
|
||||
#define set_property_allocates 2
|
||||
pointer x;
|
||||
|
||||
assert (is_symbol(obj));
|
||||
assert (is_symbol(key));
|
||||
|
||||
for (x = symprop(obj); x != sc->NIL; x = cdr(x)) {
|
||||
if (caar(x) == key)
|
||||
break;
|
||||
}
|
||||
|
||||
if (x != sc->NIL)
|
||||
cdar(x) = value;
|
||||
else {
|
||||
gc_disable(sc, gc_reservations(set_property));
|
||||
symprop(obj) = cons(sc, cons(sc, key, value), symprop(obj));
|
||||
gc_enable(sc);
|
||||
}
|
||||
|
||||
return sc->T;
|
||||
}
|
||||
#endif
|
||||
|
||||
|
||||
|
||||
#define s_retbool(tf) s_return(sc,(tf) ? sc->T : sc->F)
|
||||
|
||||
static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
|
||||
pointer x, y;
|
||||
pointer callsite;
|
||||
num v;
|
||||
#if USE_MATH
|
||||
double dd;
|
||||
#endif
|
||||
|
||||
switch (op) {
|
||||
CASE(OP_LOAD): /* load */
|
||||
@ -3968,67 +4019,6 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
|
||||
gc_enable(sc);
|
||||
s_goto(sc,OP_APPLY);
|
||||
|
||||
default:
|
||||
snprintf(sc->strbuff,STRBUFFSIZE,"%d: illegal operator", sc->op);
|
||||
Error_0(sc,sc->strbuff);
|
||||
}
|
||||
return sc->T;
|
||||
}
|
||||
|
||||
#if USE_PLIST
|
||||
static pointer
|
||||
get_property(scheme *sc, pointer obj, pointer key)
|
||||
{
|
||||
pointer x;
|
||||
|
||||
assert (is_symbol(obj));
|
||||
assert (is_symbol(key));
|
||||
|
||||
for (x = symprop(obj); x != sc->NIL; x = cdr(x)) {
|
||||
if (caar(x) == key)
|
||||
break;
|
||||
}
|
||||
|
||||
if (x != sc->NIL)
|
||||
return cdar(x);
|
||||
|
||||
return sc->NIL;
|
||||
}
|
||||
|
||||
static pointer
|
||||
set_property(scheme *sc, pointer obj, pointer key, pointer value)
|
||||
{
|
||||
#define set_property_allocates 2
|
||||
pointer x;
|
||||
|
||||
assert (is_symbol(obj));
|
||||
assert (is_symbol(key));
|
||||
|
||||
for (x = symprop(obj); x != sc->NIL; x = cdr(x)) {
|
||||
if (caar(x) == key)
|
||||
break;
|
||||
}
|
||||
|
||||
if (x != sc->NIL)
|
||||
cdar(x) = value;
|
||||
else {
|
||||
gc_disable(sc, gc_reservations(set_property));
|
||||
symprop(obj) = cons(sc, cons(sc, key, value), symprop(obj));
|
||||
gc_enable(sc);
|
||||
}
|
||||
|
||||
return sc->T;
|
||||
}
|
||||
#endif
|
||||
|
||||
static pointer opexe_2(scheme *sc, enum scheme_opcodes op) {
|
||||
pointer x;
|
||||
num v;
|
||||
#if USE_MATH
|
||||
double dd;
|
||||
#endif
|
||||
|
||||
switch (op) {
|
||||
#if USE_MATH
|
||||
CASE(OP_INEX2EX): /* inexact->exact */
|
||||
x=car(sc->args);
|
||||
|
Loading…
x
Reference in New Issue
Block a user