[git] GnuPG - branch, master, updated. gnupg-2.1.20-105-g8a168a6
by Justus Winter
cvs at cvs.gnupg.org
Wed May 3 15:40:30 CEST 2017
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "The GNU Privacy Guard".
The branch, master has been updated
via 8a168a6d4052ec31fed77c79bb96ffdd32bf9646 (commit)
via 9c6407d17e0cb9f4a370b1b83e7816577ec7d29d (commit)
from cacfd4bce94704b531f68ee76fb40789e44fde67 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 8a168a6d4052ec31fed77c79bb96ffdd32bf9646
Author: Justus Winter <justus at g10code.com>
Date: Thu Apr 6 11:52:36 2017 +0200
gpgscm: Create and re-use frame objects.
* tests/gpgscm/scheme-private.h (struct scheme): New field
'frame_freelist'.
* tests/gpgscm/scheme.c (enum scheme_types): New type 'T_FRAME'.
(type_to_string): Handle new type.
(settype): New macro.
(gc_disable): Make sure there is at least one frame in the free list.
(mark): Handle frame objects.
(finalize_cell): Likewise.
(dump_stack_initialize): Initialize free list.
(dump_stack_free): Simplify.
(frame_length): New variable.
(dump_stack_make_frame): New function.
(frame_slots): Likewise.
(frame_payload): New macro.
(dump_stack_allocate_frame): New function.
(dump_stack_deallocate_frame): Likewise.
(dump_stack_preallocate_frame): Likewise.
(_s_return): Unpack frame object and deallocate it.
(s_save): Wrap state in an frame object.
(dump_stack_mark): Mark the free list.
--
TinySCHEME being a SECD-machine needs to push frames onto the dump
stack. Previously, the dump stack was a list. This required four
cells for the spine, as well as up to one additional cell to encode
the current opcode. This was quite inefficient despite the fact that
we recovered the spine as well as the integer cell.
We introduce frame objects, which are a special variant of vectors of
length four. Since the length is fixed, this frees up the length
field of the vector object to store the unboxed opcode. A frame
object now fits in two cells.
Saving two or three cells is a mere byproduct, the performance gain
comes from increased locality, unboxed opcode representation, and the
ability to easily put the objects in a free list, keeping the garbage
collector out of the continuous motion of the virtual machine.
Signed-off-by: Justus Winter <justus at g10code.com>
diff --git a/tests/gpgscm/scheme-private.h b/tests/gpgscm/scheme-private.h
index 0ba9a53..7f92bda 100644
--- a/tests/gpgscm/scheme-private.h
+++ b/tests/gpgscm/scheme-private.h
@@ -122,6 +122,7 @@ pointer args; /* register for arguments of function */
pointer envir; /* stack register for current environment */
pointer code; /* register for current code */
pointer dump; /* stack register for next evaluation */
+pointer frame_freelist;
#if USE_HISTORY
struct history history; /* we keep track of the call history for
diff --git a/tests/gpgscm/scheme.c b/tests/gpgscm/scheme.c
index 47051f2..26bb5a5 100644
--- a/tests/gpgscm/scheme.c
+++ b/tests/gpgscm/scheme.c
@@ -139,7 +139,8 @@ enum scheme_types {
T_NIL = 17 << 1 | 1,
T_EOF_OBJ = 18 << 1 | 1,
T_SINK = 19 << 1 | 1,
- T_LAST_SYSTEM_TYPE = 19 << 1 | 1
+ T_FRAME = 20 << 1 | 1,
+ T_LAST_SYSTEM_TYPE = 20 << 1 | 1
};
static const char *
@@ -166,6 +167,7 @@ type_to_string (enum scheme_types typ)
case T_NIL: return "nil";
case T_EOF_OBJ: return "eof object";
case T_SINK: return "sink";
+ case T_FRAME: return "frame";
}
assert (! "not reached");
}
@@ -174,6 +176,7 @@ type_to_string (enum scheme_types typ)
#define TYPE_BITS 6
#define ADJ (1 << TYPE_BITS)
#define T_MASKTYPE (ADJ - 1)
+ /* 0000000000111111 */
#define T_TAGGED 1024 /* 0000010000000000 */
#define T_FINALIZE 2048 /* 0000100000000000 */
#define T_SYNTAX 4096 /* 0001000000000000 */
@@ -211,6 +214,7 @@ static const struct num num_one = { 1, {1} };
/* macros for cell operations */
#define typeflag(p) ((p)->_flag)
#define type(p) (typeflag(p)&T_MASKTYPE)
+#define settype(p, typ) (typeflag(p) = (typeflag(p) & ~T_MASKTYPE) | (typ))
INTERFACE INLINE int is_string(pointer p) { return (type(p)==T_STRING); }
#define strvalue(p) ((p)->_object._string._svalue)
@@ -299,6 +303,9 @@ INTERFACE INLINE int is_promise(pointer p) { return (type(p)==T_PROMISE); }
INTERFACE INLINE int is_environment(pointer p) { return (type(p)==T_ENVIRONMENT); }
#define setenvironment(p) typeflag(p) = T_ENVIRONMENT
+INTERFACE INLINE int is_frame(pointer p) { return (type(p) == T_FRAME); }
+#define setframe(p) settype(p, T_FRAME)
+
#define is_atom(p) (typeflag(p)&T_ATOM)
#define setatom(p) typeflag(p) |= T_ATOM
#define clratom(p) typeflag(p) &= CLRATOM
@@ -436,6 +443,7 @@ static pointer mk_continuation(scheme *sc, pointer d);
static pointer reverse(scheme *sc, pointer term, pointer list);
static pointer reverse_in_place(scheme *sc, pointer term, pointer list);
static pointer revappend(scheme *sc, pointer a, pointer b);
+static void dump_stack_preallocate_frame(scheme *sc);
static void dump_stack_mark(scheme *);
struct op_code_info {
char name[31]; /* strlen ("call-with-current-continuation") + 1 */
@@ -867,7 +875,8 @@ gc_reservation_failure(struct scheme *sc)
"insufficient reservation\n")
#else
fprintf(stderr,
- "insufficient reservation in line %d\n",
+ "insufficient %s reservation in line %d\n",
+ sc->frame_freelist == sc->NIL ? "frame" : "cell",
sc->reserved_lineno);
#endif
abort();
@@ -893,7 +902,15 @@ _gc_disable(struct scheme *sc, size_t reserve, int lineno)
sc->inhibit_gc += 1;
}
#define gc_disable(sc, reserve) \
- _gc_disable (sc, reserve, __LINE__)
+ do { \
+ if (sc->frame_freelist == sc->NIL) { \
+ if (gc_enabled(sc)) \
+ dump_stack_preallocate_frame(sc); \
+ else \
+ gc_reservation_failure(sc); \
+ } \
+ _gc_disable (sc, reserve, __LINE__); \
+ } while (0)
/* Enable the garbage collector. */
#define gc_enable(sc) \
@@ -917,7 +934,12 @@ _gc_disable(struct scheme *sc, size_t reserve, int lineno)
#else /* USE_GC_LOCKING */
-#define gc_disable(sc, reserve) (void) 0
+#define gc_reservation_failure(sc) (void) 0
+#define gc_disable(sc, reserve) \
+ do { \
+ if (sc->frame_freelist == sc->NIL) \
+ dump_stack_preallocate_frame(sc); \
+ } while (0)
#define gc_enable(sc) (void) 0
#define gc_enabled(sc) 1
#define gc_consume(sc) (void) 0
@@ -1284,8 +1306,6 @@ INTERFACE pointer mk_character(scheme *sc, int c) {
#if USE_SMALL_INTEGERS
-/* s_save assumes that all opcodes can be expressed as a small
- * integer. */
static const struct cell small_integers[] = {
#define DEFINE_INTEGER(n) { T_NUMBER | T_ATOM | MARK, {{ 1, {n}}}},
#include "small-integers.h"
@@ -1599,6 +1619,9 @@ static pointer mk_sharp_const(scheme *sc, char *name) {
/* ========== garbage collector ========== */
+const int frame_length;
+static void dump_stack_deallocate_frame(scheme *sc, pointer frame);
+
/*--
* We use algorithm E (Knuth, The Art of Computer Programming Vol.1,
* sec. 2.3.5), the Schorr-Deutsch-Waite link-inversion algorithm,
@@ -1611,9 +1634,10 @@ static void mark(pointer a) {
p = a;
E2: if (! is_mark(p))
setmark(p);
- if(is_vector(p)) {
+ if (is_vector(p) || is_frame(p)) {
int i;
- for (i = 0; i < vector_length(p); i++) {
+ int len = is_vector(p) ? vector_length(p) : frame_length;
+ for (i = 0; i < len; i++) {
mark(p->_object._vector._elements[i]);
}
}
@@ -1783,8 +1807,12 @@ finalize_cell(scheme *sc, pointer a)
sc->free_cell = p;
sc->fcells += 1;
}
- break;
} while (0);
+ break;
+
+ case T_FRAME:
+ dump_stack_deallocate_frame(sc, a);
+ return 0; /* Do not free cell. */
}
return 1; /* Free cell. */
@@ -2985,17 +3013,73 @@ static INLINE void dump_stack_reset(scheme *sc)
static INLINE void dump_stack_initialize(scheme *sc)
{
dump_stack_reset(sc);
+ sc->frame_freelist = sc->NIL;
}
static void dump_stack_free(scheme *sc)
{
- sc->dump = sc->NIL;
+ dump_stack_initialize(sc);
+}
+
+const int frame_length = 4;
+
+static pointer
+dump_stack_make_frame(scheme *sc)
+{
+ pointer frame;
+
+ frame = mk_vector(sc, frame_length);
+ if (! sc->no_memory)
+ setframe(frame);
+
+ return frame;
+}
+
+static INLINE pointer *
+frame_slots(pointer frame)
+{
+ return &frame->_object._vector._elements[0];
+}
+
+#define frame_payload vector_length
+
+static pointer
+dump_stack_allocate_frame(scheme *sc)
+{
+ pointer frame = sc->frame_freelist;
+ if (frame == sc->NIL) {
+ if (gc_enabled(sc))
+ frame = dump_stack_make_frame(sc);
+ else
+ gc_reservation_failure(sc);
+ } else
+ sc->frame_freelist = *frame_slots(frame);
+ return frame;
+}
+
+static void
+dump_stack_deallocate_frame(scheme *sc, pointer frame)
+{
+ pointer *p = frame_slots(frame);
+ *p++ = sc->frame_freelist;
+ *p++ = sc->NIL;
+ *p++ = sc->NIL;
+ *p++ = sc->NIL;
+ sc->frame_freelist = frame;
+}
+
+static void
+dump_stack_preallocate_frame(scheme *sc)
+{
+ pointer frame = dump_stack_make_frame(sc);
+ if (! sc->no_memory)
+ dump_stack_deallocate_frame(sc, frame);
}
static enum scheme_opcodes
_s_return(scheme *sc, pointer a, int enable_gc) {
pointer dump = sc->dump;
- pointer op;
+ pointer *p;
unsigned long v;
enum scheme_opcodes next_op;
sc->value = (a);
@@ -3003,37 +3087,38 @@ _s_return(scheme *sc, pointer a, int enable_gc) {
gc_enable(sc);
if (dump == sc->NIL)
return OP_QUIT;
- free_cons(sc, dump, &op, &dump);
- v = (unsigned long) ivalue_unchecked(op);
+ v = frame_payload(dump);
next_op = (int) (v & S_OP_MASK);
sc->flags = v & S_FLAG_MASK;
-#ifdef USE_SMALL_INTEGERS
- if (v < MAX_SMALL_INTEGER) {
- /* This is a small integer, we must not free it. */
- } else
- /* Normal integer. Recover the cell. */
-#endif
- free_cell(sc, op);
- free_cons(sc, dump, &sc->args, &dump);
- free_cons(sc, dump, &sc->envir, &dump);
- free_cons(sc, dump, &sc->code, &sc->dump);
+ p = frame_slots(dump);
+ sc->args = *p++;
+ sc->envir = *p++;
+ sc->code = *p++;
+ sc->dump = *p++;
+ dump_stack_deallocate_frame(sc, dump);
return next_op;
}
static void s_save(scheme *sc, enum scheme_opcodes op, pointer args, pointer code) {
-#define s_save_allocates 5
+#define s_save_allocates 0
pointer dump;
- unsigned long v = sc->flags | ((unsigned long) op);
+ pointer *p;
gc_disable(sc, gc_reservations (s_save));
- dump = cons(sc, sc->envir, cons(sc, (code), sc->dump));
- dump = cons(sc, (args), dump);
- sc->dump = cons(sc, mk_integer(sc, (long) v), dump);
+ dump = dump_stack_allocate_frame(sc);
+ frame_payload(dump) = (size_t) (sc->flags | (unsigned long) op);
+ p = frame_slots(dump);
+ *p++ = args;
+ *p++ = sc->envir;
+ *p++ = code;
+ *p++ = sc->dump;
+ sc->dump = dump;
gc_enable(sc);
}
static INLINE void dump_stack_mark(scheme *sc)
{
mark(sc->dump);
+ mark(sc->frame_freelist);
}
commit 9c6407d17e0cb9f4a370b1b83e7816577ec7d29d
Author: Justus Winter <justus at g10code.com>
Date: Wed Apr 5 17:30:44 2017 +0200
gpgscm: Merge opexe_0.
* tests/gpgscm/scheme-private.h (struct scheme): Remove field 'op'.
* tests/gpgscm/scheme.c (opexe_0): Inline into 'Eval_Cycle'.
(_Error_1): Return the opcode to evaluate next.
(Error_1): Do not return, but set the opcode and goto dispatch.
(Error_0): Likewise.
(s_goto): Likewise.
(s_return): Likewise.
(s_return_enable_gc): Likewise.
(s_thread_to): Remove superfluous cast.
(_s_return): Return the opcode to evaluate next.
(scheme_init_custom_alloc): Adapt to removal of field 'op'.
Signed-off-by: Justus Winter <justus at g10code.com>
diff --git a/tests/gpgscm/scheme-private.h b/tests/gpgscm/scheme-private.h
index bc0269a..0ba9a53 100644
--- a/tests/gpgscm/scheme-private.h
+++ b/tests/gpgscm/scheme-private.h
@@ -196,7 +196,6 @@ FILE *tmpfp;
int tok;
int print_flag;
pointer value;
-int op;
unsigned int flags;
void *ext_data; /* For the benefit of foreign functions */
diff --git a/tests/gpgscm/scheme.c b/tests/gpgscm/scheme.c
index 811c51f..47051f2 100644
--- a/tests/gpgscm/scheme.c
+++ b/tests/gpgscm/scheme.c
@@ -437,7 +437,6 @@ static pointer reverse(scheme *sc, pointer term, pointer list);
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);
struct op_code_info {
char name[31]; /* strlen ("call-with-current-continuation") + 1 */
unsigned char min_arity;
@@ -2834,7 +2833,8 @@ static INLINE pointer slot_value_in_env(pointer slot)
/* ========== Evaluation Cycle ========== */
-static pointer _Error_1(scheme *sc, const char *s, pointer a) {
+static enum scheme_opcodes
+_Error_1(scheme *sc, const char *s, pointer a) {
const char *str = s;
pointer history;
#if USE_ERROR_HOOK
@@ -2892,8 +2892,7 @@ static pointer _Error_1(scheme *sc, const char *s, pointer a) {
sc->code = cons(sc, mk_string(sc, str), sc->code);
setimmutable(car(sc->code));
sc->code = cons(sc, slot_value_in_env(x), sc->code);
- sc->op = (int)OP_EVAL;
- return sc->T;
+ return OP_EVAL;
}
#endif
@@ -2904,11 +2903,10 @@ static pointer _Error_1(scheme *sc, const char *s, pointer a) {
}
sc->args = cons(sc, mk_string(sc, str), sc->args);
setimmutable(car(sc->args));
- sc->op = (int)OP_ERR0;
- return sc->T;
+ return OP_ERR0;
}
-#define Error_1(sc,s, a) return _Error_1(sc,s,a)
-#define Error_0(sc,s) return _Error_1(sc,s,0)
+#define Error_1(sc,s, a) { op = _Error_1(sc,s,a); goto dispatch; }
+#define Error_0(sc,s) { op = _Error_1(sc,s,0); goto dispatch; }
/* Too small to turn into function */
# define BEGIN do {
@@ -2949,9 +2947,7 @@ static pointer _Error_1(scheme *sc, const char *s, pointer a) {
/* Bounce back to Eval_Cycle and execute A. */
-#define s_goto(sc,a) BEGIN \
- sc->op = (int)(a); \
- return sc->T; END
+#define s_goto(sc, a) { op = (a); goto dispatch; }
#if USE_THREADED_CODE
@@ -2959,7 +2955,7 @@ static pointer _Error_1(scheme *sc, const char *s, pointer a) {
* to it. */
#define s_thread_to(sc, a) \
BEGIN \
- op = (int) (a); \
+ op = (a); \
goto a; \
END
@@ -2975,11 +2971,11 @@ static pointer _Error_1(scheme *sc, const char *s, pointer a) {
/* Return to the previous frame on the dump stack, setting the current
* value to A. */
-#define s_return(sc, a) return _s_return(sc, a, 0)
+#define s_return(sc, a) s_goto(sc, _s_return(sc, a, 0))
/* Return to the previous frame on the dump stack, setting the current
* value to A, and re-enable the garbage collector. */
-#define s_return_enable_gc(sc, a) return _s_return(sc, a, 1)
+#define s_return_enable_gc(sc, a) s_goto(sc, _s_return(sc, a, 1))
static INLINE void dump_stack_reset(scheme *sc)
{
@@ -2996,18 +2992,20 @@ static void dump_stack_free(scheme *sc)
sc->dump = sc->NIL;
}
-static pointer _s_return(scheme *sc, pointer a, int enable_gc) {
+static enum scheme_opcodes
+_s_return(scheme *sc, pointer a, int enable_gc) {
pointer dump = sc->dump;
pointer op;
unsigned long v;
+ enum scheme_opcodes next_op;
sc->value = (a);
if (enable_gc)
gc_enable(sc);
if (dump == sc->NIL)
- return sc->NIL;
+ return OP_QUIT;
free_cons(sc, dump, &op, &dump);
v = (unsigned long) ivalue_unchecked(op);
- sc->op = (int) (v & S_OP_MASK);
+ next_op = (int) (v & S_OP_MASK);
sc->flags = v & S_FLAG_MASK;
#ifdef USE_SMALL_INTEGERS
if (v < MAX_SMALL_INTEGER) {
@@ -3019,7 +3017,7 @@ static pointer _s_return(scheme *sc, pointer a, int enable_gc) {
free_cons(sc, dump, &sc->args, &dump);
free_cons(sc, dump, &sc->envir, &dump);
free_cons(sc, dump, &sc->code, &sc->dump);
- return sc->T;
+ return next_op;
}
static void s_save(scheme *sc, enum scheme_opcodes op, pointer args, pointer code) {
@@ -3357,7 +3355,10 @@ int list_length(scheme *sc, pointer a) {
#define s_retbool(tf) s_return(sc,(tf) ? sc->T : sc->F)
-static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
+/* kernel of this interpreter */
+static void
+Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
+ for (;;) {
pointer x, y;
pointer callsite;
num v;
@@ -3365,6 +3366,21 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
double dd;
#endif
int (*comp_func)(num, num) = NULL;
+ const struct op_code_info *pcd = &dispatch_table[op];
+
+ dispatch:
+ if (pcd->name[0] != 0) { /* if built-in function, check arguments */
+ char msg[STRBUFFSIZE];
+ if (! check_arguments (sc, pcd, msg, sizeof msg)) {
+ s_goto(sc, _Error_1(sc, msg, 0));
+ }
+ }
+
+ if(sc->no_memory) {
+ fprintf(stderr,"No memory!\n");
+ exit(1);
+ }
+ ok_to_freely_gc(sc);
switch (op) {
CASE(OP_LOAD): /* load */
@@ -4693,7 +4709,7 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
if(sc->interactive_repl) {
s_thread_to(sc,OP_T0LVL);
} else {
- return sc->NIL;
+ return;
}
}
@@ -4760,7 +4776,7 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
if(is_pair(sc->args)) {
sc->retcode=ivalue(car(sc->args));
}
- return (sc->NIL);
+ return;
CASE(OP_GC): /* gc */
gc(sc, sc->NIL, sc->NIL);
@@ -5206,7 +5222,7 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
snprintf(sc->strbuff,STRBUFFSIZE,"%d: illegal operator", op);
Error_0(sc,sc->strbuff);
}
- return sc->T; /* NOTREACHED */
+ }
}
typedef int (*test_predicate)(pointer);
@@ -5335,31 +5351,6 @@ check_arguments (scheme *sc, const struct op_code_info *pcd, char *msg, size_t m
return ok;
}
-/* kernel of this interpreter */
-static void Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
- sc->op = op;
- for (;;) {
- const struct op_code_info *pcd=dispatch_table+sc->op;
- if (pcd->name[0] != 0) { /* if built-in function, check arguments */
- char msg[STRBUFFSIZE];
- if (! check_arguments (sc, pcd, msg, sizeof msg)) {
- if(_Error_1(sc,msg,0)==sc->NIL) {
- return;
- }
- pcd=dispatch_table+sc->op;
- }
- }
- ok_to_freely_gc(sc);
- if (opexe_0(sc, (enum scheme_opcodes)sc->op) == sc->NIL) {
- return;
- }
- if(sc->no_memory) {
- fprintf(stderr,"No memory!\n");
- exit(1);
- }
- }
-}
-
/* ========== Initialization of internal keywords ========== */
/* Symbols representing syntax are tagged with (OP . '()). */
@@ -5551,7 +5542,6 @@ int scheme_init_custom_alloc(scheme *sc, func_alloc malloc, func_dealloc free) {
dump_stack_initialize(sc);
sc->code = sc->NIL;
sc->tracing=0;
- sc->op = -1;
sc->flags = 0;
/* init sc->NIL */
-----------------------------------------------------------------------
Summary of changes:
tests/gpgscm/scheme-private.h | 2 +-
tests/gpgscm/scheme.c | 227 ++++++++++++++++++++++++++++--------------
2 files changed, 152 insertions(+), 77 deletions(-)
hooks/post-receive
--
The GNU Privacy Guard
http://git.gnupg.org
More information about the Gnupg-commits
mailing list