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@g10code.com>
This commit is contained in:
Justus Winter 2017-04-06 11:52:36 +02:00
parent 9c6407d17e
commit 8a168a6d40
No known key found for this signature in database
GPG Key ID: DD1A52F9DA8C9020
2 changed files with 114 additions and 28 deletions

View File

@ -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

View File

@ -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);
}