security-and-privacy/gnupg
security-and-privacy/gnupg
1
0
Fork 0
mirror of git://git.gnupg.org/gnupg.git synced 2025-04-17 15:44:34 +02:00
Code Activity

gpgscm: Use more threaded code.

Browse Source 
* tests/gpgscm/scheme.c (opexe_0): Use 's_thread_to' instead of
's_goto' wherever possible.

Signed-off-by: Justus Winter <justus@g10code.com>
This commit is contained in:
Justus Winter 2017-03-29 14:24:49 +02:00
parent e7ed9822e2
commit 6f217d116d
No known key found for this signature in database
GPG Key ID: DD1A52F9DA8C9020
1 changed files with 37 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
tests/gpgscm/scheme.c
View File

@ -2963,8 +2963,7 @@ static pointer _Error_1(scheme *sc, const char *s, pointer a) {
#if USE_THREADED_CODE #if USE_THREADED_CODE
/* Do not bounce back to Eval_Cycle but execute A by jumping directly /* Do not bounce back to Eval_Cycle but execute A by jumping directly
* to it. Only applicable if A is part of the same dispatch * to it. */
* function. */
#define s_thread_to(sc, a) \ #define s_thread_to(sc, a) \
BEGIN \ BEGIN \
op = (int) (a); \ op = (int) (a); \
@ -2972,7 +2971,7 @@ static pointer _Error_1(scheme *sc, const char *s, pointer a) {
END END
/* Define a label OP and emit a case statement for OP. For use in the /* Define a label OP and emit a case statement for OP. For use in the
* dispatch functions. The slightly peculiar goto that is never * dispatch function. The slightly peculiar goto that is never
* executed avoids warnings about unused labels. */ * executed avoids warnings about unused labels. */
#define CASE(OP) if (0) goto OP; OP: case OP #define CASE(OP) if (0) goto OP; OP: case OP
@ -3397,7 +3396,7 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
{ {
sc->args=sc->NIL; sc->args=sc->NIL;
sc->nesting = sc->nesting_stack[0]; sc->nesting = sc->nesting_stack[0];
s_goto(sc,OP_QUIT); s_thread_to(sc,OP_QUIT);
} }
else else
{ {
@ -3434,7 +3433,7 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
sc->tok = token(sc); sc->tok = token(sc);
if(sc->tok==TOK_EOF) if(sc->tok==TOK_EOF)
{ s_return(sc,sc->EOF_OBJ); } { s_return(sc,sc->EOF_OBJ); }
s_goto(sc,OP_RDSEXPR); s_thread_to(sc,OP_RDSEXPR);
CASE(OP_GENSYM): CASE(OP_GENSYM):
s_return(sc, gensym(sc)); s_return(sc, gensym(sc));
@ -3449,7 +3448,7 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
if(file_interactive(sc)) { if(file_interactive(sc)) {
sc->print_flag = 1; sc->print_flag = 1;
sc->args = sc->value; sc->args = sc->value;
s_goto(sc,OP_P0LIST); s_thread_to(sc,OP_P0LIST);
} else { } else {
s_return(sc,sc->value); s_return(sc,sc->value);
} }
@ -3461,7 +3460,7 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
s_save(sc,OP_REAL_EVAL,sc->args,sc->code); s_save(sc,OP_REAL_EVAL,sc->args,sc->code);
sc->args=sc->code; sc->args=sc->code;
putstr(sc,"\nEval: "); putstr(sc,"\nEval: ");
s_goto(sc,OP_P0LIST); s_thread_to(sc,OP_P0LIST);
} }
/* fall through */ /* fall through */
CASE(OP_REAL_EVAL): CASE(OP_REAL_EVAL):
@ -3550,7 +3549,7 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
sc->print_flag = 1; sc->print_flag = 1;
/* sc->args=cons(sc,sc->code,sc->args);*/ /* sc->args=cons(sc,sc->code,sc->args);*/
putstr(sc,"\nApply to: "); putstr(sc,"\nApply to: ");
s_goto(sc,OP_P0LIST); s_thread_to(sc,OP_P0LIST);
} }
/* fall through */ /* fall through */
CASE(OP_REAL_APPLY): CASE(OP_REAL_APPLY):
@ -3856,7 +3855,7 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
sc->code = cadar(sc->code); sc->code = cadar(sc->code);
sc->args = sc->NIL; sc->args = sc->NIL;
s_clear_flag(sc, TAIL_CONTEXT); s_clear_flag(sc, TAIL_CONTEXT);
s_goto(sc,OP_EVAL); s_thread_to(sc,OP_EVAL);
} else { /* end */ } else { /* end */
sc->args = reverse_in_place(sc, sc->NIL, sc->args); sc->args = reverse_in_place(sc, sc->NIL, sc->args);
sc->code = car(sc->args); sc->code = car(sc->args);
@ -3870,7 +3869,7 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
} }
sc->code = cdr(sc->code); sc->code = cdr(sc->code);
sc->args = sc->NIL; sc->args = sc->NIL;
s_goto(sc,OP_BEGIN); s_thread_to(sc,OP_BEGIN);
CASE(OP_COND0): /* cond */ CASE(OP_COND0): /* cond */
if (!is_pair(sc->code)) { if (!is_pair(sc->code)) {
@ -3879,7 +3878,7 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
s_save(sc,OP_COND1, sc->NIL, sc->code); s_save(sc,OP_COND1, sc->NIL, sc->code);
sc->code = caar(sc->code); sc->code = caar(sc->code);
s_clear_flag(sc, TAIL_CONTEXT); s_clear_flag(sc, TAIL_CONTEXT);
s_goto(sc,OP_EVAL); s_thread_to(sc,OP_EVAL);
CASE(OP_COND1): /* cond */ CASE(OP_COND1): /* cond */
if (is_true(sc->value)) { if (is_true(sc->value)) {
@ -3894,9 +3893,9 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
x=cons(sc, sc->QUOTE, cons(sc, sc->value, sc->NIL)); x=cons(sc, sc->QUOTE, cons(sc, sc->value, sc->NIL));
sc->code=cons(sc,cadr(sc->code),cons(sc,x,sc->NIL)); sc->code=cons(sc,cadr(sc->code),cons(sc,x,sc->NIL));
gc_enable(sc); gc_enable(sc);
s_goto(sc,OP_EVAL); s_thread_to(sc,OP_EVAL);
} }
s_goto(sc,OP_BEGIN); s_thread_to(sc,OP_BEGIN);
} else { } else {
if ((sc->code = cdr(sc->code)) == sc->NIL) { if ((sc->code = cdr(sc->code)) == sc->NIL) {
s_return(sc,sc->NIL); s_return(sc,sc->NIL);
@ -3904,7 +3903,7 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
s_save(sc,OP_COND1, sc->NIL, sc->code); s_save(sc,OP_COND1, sc->NIL, sc->code);
sc->code = caar(sc->code); sc->code = caar(sc->code);
s_clear_flag(sc, TAIL_CONTEXT); s_clear_flag(sc, TAIL_CONTEXT);
s_goto(sc,OP_EVAL); s_thread_to(sc,OP_EVAL);
} }
} }
@ -3922,7 +3921,7 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
if (cdr(sc->code) != sc->NIL) if (cdr(sc->code) != sc->NIL)
s_clear_flag(sc, TAIL_CONTEXT); s_clear_flag(sc, TAIL_CONTEXT);
sc->code = car(sc->code); sc->code = car(sc->code);
s_goto(sc,OP_EVAL); s_thread_to(sc,OP_EVAL);
CASE(OP_AND1): /* and */ CASE(OP_AND1): /* and */
if (is_false(sc->value)) { if (is_false(sc->value)) {
@ -3934,7 +3933,7 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
if (cdr(sc->code) != sc->NIL) if (cdr(sc->code) != sc->NIL)
s_clear_flag(sc, TAIL_CONTEXT); s_clear_flag(sc, TAIL_CONTEXT);
sc->code = car(sc->code); sc->code = car(sc->code);
s_goto(sc,OP_EVAL); s_thread_to(sc,OP_EVAL);
} }
CASE(OP_OR0): /* or */ CASE(OP_OR0): /* or */
@ -3945,7 +3944,7 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
if (cdr(sc->code) != sc->NIL) if (cdr(sc->code) != sc->NIL)
s_clear_flag(sc, TAIL_CONTEXT); s_clear_flag(sc, TAIL_CONTEXT);
sc->code = car(sc->code); sc->code = car(sc->code);
s_goto(sc,OP_EVAL); s_thread_to(sc,OP_EVAL);
CASE(OP_OR1): /* or */ CASE(OP_OR1): /* or */
if (is_true(sc->value)) { if (is_true(sc->value)) {
@ -3957,13 +3956,13 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
if (cdr(sc->code) != sc->NIL) if (cdr(sc->code) != sc->NIL)
s_clear_flag(sc, TAIL_CONTEXT); s_clear_flag(sc, TAIL_CONTEXT);
sc->code = car(sc->code); sc->code = car(sc->code);
s_goto(sc,OP_EVAL); s_thread_to(sc,OP_EVAL);
} }
CASE(OP_C0STREAM): /* cons-stream */ CASE(OP_C0STREAM): /* cons-stream */
s_save(sc,OP_C1STREAM, sc->NIL, cdr(sc->code)); s_save(sc,OP_C1STREAM, sc->NIL, cdr(sc->code));
sc->code = car(sc->code); sc->code = car(sc->code);
s_goto(sc,OP_EVAL); s_thread_to(sc,OP_EVAL);
CASE(OP_C1STREAM): /* cons-stream */ CASE(OP_C1STREAM): /* cons-stream */
sc->args = sc->value; /* save sc->value to register sc->args for gc */ sc->args = sc->value; /* save sc->value to register sc->args for gc */
@ -3986,7 +3985,7 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
Error_0(sc,"variable is not a symbol"); Error_0(sc,"variable is not a symbol");
} }
s_save(sc,OP_MACRO1, sc->NIL, x); s_save(sc,OP_MACRO1, sc->NIL, x);
s_goto(sc,OP_EVAL); s_thread_to(sc,OP_EVAL);
CASE(OP_MACRO1): { /* macro */ CASE(OP_MACRO1): { /* macro */
pointer *sslot; pointer *sslot;
@ -4004,7 +4003,7 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
s_save(sc,OP_CASE1, sc->NIL, cdr(sc->code)); s_save(sc,OP_CASE1, sc->NIL, cdr(sc->code));
sc->code = car(sc->code); sc->code = car(sc->code);
s_clear_flag(sc, TAIL_CONTEXT); s_clear_flag(sc, TAIL_CONTEXT);
s_goto(sc,OP_EVAL); s_thread_to(sc,OP_EVAL);
CASE(OP_CASE1): /* case */ CASE(OP_CASE1): /* case */
for (x = sc->code; x != sc->NIL; x = cdr(x)) { for (x = sc->code; x != sc->NIL; x = cdr(x)) {
@ -4023,11 +4022,11 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
if (x != sc->NIL) { if (x != sc->NIL) {
if (is_pair(caar(x))) { if (is_pair(caar(x))) {
sc->code = cdar(x); sc->code = cdar(x);
s_goto(sc,OP_BEGIN); s_thread_to(sc,OP_BEGIN);
} else {/* else */ } else {/* else */
s_save(sc,OP_CASE2, sc->NIL, cdar(x)); s_save(sc,OP_CASE2, sc->NIL, cdar(x));
sc->code = caar(x); sc->code = caar(x);
s_goto(sc,OP_EVAL); s_thread_to(sc,OP_EVAL);
} }
} else { } else {
s_return(sc,sc->NIL); s_return(sc,sc->NIL);
@ -4035,7 +4034,7 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
CASE(OP_CASE2): /* case */ CASE(OP_CASE2): /* case */
if (is_true(sc->value)) { if (is_true(sc->value)) {
s_goto(sc,OP_BEGIN); s_thread_to(sc,OP_BEGIN);
} else { } else {
s_return(sc,sc->NIL); s_return(sc,sc->NIL);
} }
@ -4044,21 +4043,21 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
sc->code = car(sc->args); sc->code = car(sc->args);
sc->args = list_star(sc,cdr(sc->args)); sc->args = list_star(sc,cdr(sc->args));
/*sc->args = cadr(sc->args);*/ /*sc->args = cadr(sc->args);*/
s_goto(sc,OP_APPLY); s_thread_to(sc,OP_APPLY);
CASE(OP_PEVAL): /* eval */ CASE(OP_PEVAL): /* eval */
if(cdr(sc->args)!=sc->NIL) { if(cdr(sc->args)!=sc->NIL) {
sc->envir=cadr(sc->args); sc->envir=cadr(sc->args);
} }
sc->code = car(sc->args); sc->code = car(sc->args);
s_goto(sc,OP_EVAL); s_thread_to(sc,OP_EVAL);
CASE(OP_CONTINUATION): /* call-with-current-continuation */ CASE(OP_CONTINUATION): /* call-with-current-continuation */
sc->code = car(sc->args); sc->code = car(sc->args);
gc_disable(sc, 2); gc_disable(sc, 2);
sc->args = cons(sc, mk_continuation(sc, sc->dump), sc->NIL); sc->args = cons(sc, mk_continuation(sc, sc->dump), sc->NIL);
gc_enable(sc); gc_enable(sc);
s_goto(sc,OP_APPLY); s_thread_to(sc,OP_APPLY);
#if USE_MATH #if USE_MATH
CASE(OP_INEX2EX): /* inexact->exact */ CASE(OP_INEX2EX): /* inexact->exact */
@ -4637,7 +4636,7 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
/* Should change type to closure here */ /* Should change type to closure here */
s_save(sc, OP_SAVE_FORCED, sc->NIL, sc->code); s_save(sc, OP_SAVE_FORCED, sc->NIL, sc->code);
sc->args = sc->NIL; sc->args = sc->NIL;
s_goto(sc,OP_APPLY); s_thread_to(sc,OP_APPLY);
} else { } else {
s_return(sc,sc->code); s_return(sc,sc->code);
} }
@ -4662,7 +4661,7 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
} else { } else {
sc->print_flag = 0; sc->print_flag = 0;
} }
s_goto(sc,OP_P0LIST); s_thread_to(sc,OP_P0LIST);
CASE(OP_NEWLINE): /* newline */ CASE(OP_NEWLINE): /* newline */
if(is_pair(sc->args)) { if(is_pair(sc->args)) {
@ -4692,11 +4691,11 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
s_save(sc,OP_ERR1, cdr(sc->args), sc->NIL); s_save(sc,OP_ERR1, cdr(sc->args), sc->NIL);
sc->args = car(sc->args); sc->args = car(sc->args);
sc->print_flag = 1; sc->print_flag = 1;
s_goto(sc,OP_P0LIST); s_thread_to(sc,OP_P0LIST);
} else { } else {
putstr(sc, "\n"); putstr(sc, "\n");
if(sc->interactive_repl) { if(sc->interactive_repl) {
s_goto(sc,OP_T0LVL); s_thread_to(sc,OP_T0LVL);
} else { } else {
return sc->NIL; return sc->NIL;
} }
@ -4879,19 +4878,19 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
/* ========== reading part ========== */ /* ========== reading part ========== */
CASE(OP_READ): CASE(OP_READ):
if(!is_pair(sc->args)) { if(!is_pair(sc->args)) {
s_goto(sc,OP_READ_INTERNAL); s_thread_to(sc,OP_READ_INTERNAL);
} }
if(!is_inport(car(sc->args))) { if(!is_inport(car(sc->args))) {
Error_1(sc,"read: not an input port:",car(sc->args)); Error_1(sc,"read: not an input port:",car(sc->args));
} }
if(car(sc->args)==sc->inport) { if(car(sc->args)==sc->inport) {
s_goto(sc,OP_READ_INTERNAL); s_thread_to(sc,OP_READ_INTERNAL);
} }
x=sc->inport; x=sc->inport;
sc->inport=car(sc->args); sc->inport=car(sc->args);
x=cons(sc,x,sc->NIL); x=cons(sc,x,sc->NIL);
s_save(sc,OP_SET_INPORT, x, sc->NIL); s_save(sc,OP_SET_INPORT, x, sc->NIL);
s_goto(sc,OP_READ_INTERNAL); s_thread_to(sc,OP_READ_INTERNAL);
CASE(OP_READ_CHAR): /* read-char */ CASE(OP_READ_CHAR): /* read-char */
CASE(OP_PEEK_CHAR): /* peek-char */ { CASE(OP_PEEK_CHAR): /* peek-char */ {
@ -5000,7 +4999,7 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
Error_0(sc,"undefined sharp expression"); Error_0(sc,"undefined sharp expression");
} else { } else {
sc->code=cons(sc,slot_value_in_env(f),sc->NIL); sc->code=cons(sc,slot_value_in_env(f),sc->NIL);
s_goto(sc,OP_EVAL); s_thread_to(sc,OP_EVAL);
} }
} }
case TOK_SHARP_CONST: case TOK_SHARP_CONST:
@ -5077,14 +5076,14 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
CASE(OP_RDVEC): CASE(OP_RDVEC):
/*sc->code=cons(sc,mk_proc(sc,OP_VECTOR),sc->value); /*sc->code=cons(sc,mk_proc(sc,OP_VECTOR),sc->value);
s_goto(sc,OP_EVAL); Cannot be quoted*/ s_thread_to(sc,OP_EVAL); Cannot be quoted*/
/*x=cons(sc,mk_proc(sc,OP_VECTOR),sc->value); /*x=cons(sc,mk_proc(sc,OP_VECTOR),sc->value);
s_return(sc,x); Cannot be part of pairs*/ s_return(sc,x); Cannot be part of pairs*/
/*sc->code=mk_proc(sc,OP_VECTOR); /*sc->code=mk_proc(sc,OP_VECTOR);
sc->args=sc->value; sc->args=sc->value;
s_goto(sc,OP_APPLY);*/ s_thread_to(sc,OP_APPLY);*/
sc->args=sc->value; sc->args=sc->value;
s_goto(sc,OP_VECTOR); s_thread_to(sc,OP_VECTOR);
/* ========== printing part ========== */ /* ========== printing part ========== */
CASE(OP_P0LIST): CASE(OP_P0LIST):