From 8a168a6d4052ec31fed77c79bb96ffdd32bf9646 Mon Sep 17 00:00:00 2001 From: Justus Winter Date: Thu, 6 Apr 2017 11:52:36 +0200 Subject: [PATCH] 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 --- tests/gpgscm/scheme-private.h | 1 + tests/gpgscm/scheme.c | 141 +++++++++++++++++++++++++++------- 2 files changed, 114 insertions(+), 28 deletions(-) diff --git a/tests/gpgscm/scheme-private.h b/tests/gpgscm/scheme-private.h index 0ba9a53a5..7f92bda2c 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 47051f209..26bb5a5c2 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); }