gnupg/tests/gpgscm/scheme-private.h

Ignoring revisions in .git-blame-ignore-revs. Click here to bypass and see the normal blame view.

275 lines
6.3 KiB
C
Raw Normal View History

/* scheme-private.h */
#ifndef _SCHEME_PRIVATE_H
#define _SCHEME_PRIVATE_H
#include <stdint.h>
#include "scheme.h"
/*------------------ Ugly internals -----------------------------------*/
/*------------------ Of interest only to FFI users --------------------*/
#ifdef __cplusplus
extern "C" {
#endif
enum scheme_port_kind {
port_free=0,
port_file=1,
port_string=2,
port_srfi6=4,
port_input=16,
port_output=32,
port_saw_EOF=64
};
typedef struct port {
unsigned char kind;
union {
struct {
FILE *file;
int closeit;
} stdio;
struct {
char *start;
char *past_the_end;
char *curr;
} string;
} rep;
#if SHOW_ERROR_LINE
pointer curr_line;
pointer filename;
#endif
} port;
/* cell structure */
struct cell {
uintptr_t _flag;
union {
num _number;
struct {
char *_svalue;
int _length;
} _string;
port *_port;
foreign_func _ff;
struct {
struct cell *_car;
struct cell *_cdr;
} _cons;
struct {
size_t _length;
pointer _elements[0];
} _vector;
struct {
char *_data;
const foreign_object_vtable *_vtable;
} _foreign_object;
} _object;
};
#if USE_HISTORY
/* The history is a two-dimensional ring buffer. A donut-shaped data
* structure. This data structure is inspired by MIT/GNU Scheme. */
struct history {
/* Number of calls to store. Must be a power of two. */
size_t N;
/* Number of tail-calls to store in each call frame. Must be a
* power of two. */
size_t M;
/* Masks for fast index calculations. */
size_t mask_N;
size_t mask_M;
/* A vector of size N containing calls. */
pointer callstack;
/* A vector of size N containing vectors of size M containing tail
* calls. */
pointer tailstacks;
/* Our current position. */
size_t n;
size_t *m;
};
#endif
struct scheme {
/* arrays for segments */
func_alloc malloc;
func_dealloc free;
/* return code */
int retcode;
int tracing;
#ifndef CELL_SEGSIZE
#define CELL_SEGSIZE 5000 /* # of cells in one segment */
#endif
/* If less than # of cells are recovered in a garbage collector run,
* allocate a new cell segment to avoid fruitless collection cycles in
* the near future. */
#ifndef CELL_MINRECOVER
#define CELL_MINRECOVER (CELL_SEGSIZE >> 2)
#endif
struct cell_segment *cell_segments;
/* We use 4 registers. */
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 */
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>
2017-04-06 11:52:36 +02:00
pointer frame_freelist;
#if USE_HISTORY
struct history history; /* we keep track of the call history for
* error messages */
#endif
int interactive_repl; /* are we in an interactive REPL? */
struct cell _sink;
pointer sink; /* when mem. alloc. fails */
struct cell _NIL;
pointer NIL; /* special cell representing empty cell */
struct cell _HASHT;
pointer T; /* special cell representing #t */
struct cell _HASHF;
pointer F; /* special cell representing #f */
struct cell _EOF_OBJ;
pointer EOF_OBJ; /* special cell representing end-of-file object */
pointer oblist; /* pointer to symbol table */
pointer global_env; /* pointer to global environment */
pointer c_nest; /* stack for nested calls from C */
/* global pointers to special symbols */
pointer LAMBDA; /* pointer to syntax lambda */
pointer QUOTE; /* pointer to syntax quote */
pointer QQUOTE; /* pointer to symbol quasiquote */
pointer UNQUOTE; /* pointer to symbol unquote */
pointer UNQUOTESP; /* pointer to symbol unquote-splicing */
pointer FEED_TO; /* => */
pointer COLON_HOOK; /* *colon-hook* */
pointer ERROR_HOOK; /* *error-hook* */
pointer SHARP_HOOK; /* *sharp-hook* */
#if USE_COMPILE_HOOK
pointer COMPILE_HOOK; /* *compile-hook* */
#endif
pointer free_cell; /* pointer to top of free cells */
long fcells; /* # of free cells */
gpgscm: Avoid cell allocation overhead. * tests/gpgscm/scheme-private.h (struct scheme): New fields 'inhibit_gc', 'reserved_cells', and 'reserved_lineno'. * tests/gpgscm/scheme.c (GC_ENABLED): New macro. (USE_GC_LOCKING): Likewise. (gc_reservations): Likewise. (gc_reservation_failure): New function. (_gc_disable): Likewise. (gc_disable): New macro. (gc_enable): Likewise. (gc_enabled): Likewise. (gc_consume): Likewise. (get_cell_x): Consume reserved cell if garbage collection is disabled. (_get_cell): Assert that gc is enabled. (get_cell): Only record cell in the list of recently allocated cells if gc is enabled. (get_vector_object): Likewise. (gc): Assert that gc is enabled. (s_return): Add comment, adjust call to '_s_return'. (s_return_enable_gc): New macro. (_s_return): Add flag 'enable_gc' and re-enable gc if set. (oblist_add_by_name): Use the new facilities to protect the allocations. (new_frame_in_env): Likewise. (new_slot_spec_in_env): Likewise. (s_save): Likewise. (opexe_0): Likewise. (opexe_1): Likewise. (opexe_2): Likewise. (opexe_5): Likewise. (opexe_6): Likewise. (scheme_init_custom_alloc): Initialize the new fields. -- Every time a cell is allocated, the interpreter may run out of free cells and do a garbage collection. This is problematic because it might garbage collect objects that have been allocated, but are not yet made available to the interpreter. Previously, we would plug such newly allocated cells into the list of newly allocated objects rooted at car(sc->sink), but that requires allocating yet another cell increasing pressure on the memory management system. A faster alternative is to preallocate the cells needed for an operation and make sure the garbage collection is not run until all allocated objects are plugged in. This can be done with gc_disable and gc_enable. This optimization can be applied incrementally. This commit picks all low-hanging fruits. Signed-off-by: Justus Winter <justus@g10code.com>
2016-11-14 12:37:36 +01:00
size_t inhibit_gc; /* nesting of gc_disable */
size_t reserved_cells; /* # of reserved cells */
#ifndef NDEBUG
int reserved_lineno; /* location of last reservation */
#endif
pointer inport;
pointer outport;
pointer save_inport;
pointer loadport;
#ifndef MAXFIL
#define MAXFIL 64
#endif
port load_stack[MAXFIL]; /* Stack of open files for port -1 (LOADing) */
int nesting_stack[MAXFIL];
int file_i;
int nesting;
char gc_verbose; /* if gc_verbose is not zero, print gc status */
char no_memory; /* Whether mem. alloc. has failed */
#ifndef LINESIZE
#define LINESIZE 1024
#endif
char linebuff[LINESIZE];
#ifndef STRBUFFSIZE
#define STRBUFFSIZE 256
#endif
char *strbuff;
size_t strbuff_size;
FILE *tmpfp;
int tok;
int print_flag;
pointer value;
unsigned int flags;
void *ext_data; /* For the benefit of foreign functions */
long gensym_cnt;
const struct scheme_interface *vptr;
};
/* operator code */
enum scheme_opcodes {
#define _OP_DEF(A,B,C,D,OP) OP,
#include "opdefines.h"
OP_MAXDEFINED
};
#define cons(sc,a,b) _cons(sc,a,b,0)
#define immutable_cons(sc,a,b) _cons(sc,a,b,1)
int is_string(pointer p);
char *string_value(pointer p);
int is_number(pointer p);
num nvalue(pointer p);
long ivalue(pointer p);
double rvalue(pointer p);
int is_integer(pointer p);
int is_real(pointer p);
int is_character(pointer p);
long charvalue(pointer p);
int is_vector(pointer p);
int is_port(pointer p);
int is_pair(pointer p);
pointer pair_car(pointer p);
pointer pair_cdr(pointer p);
pointer set_car(pointer p, pointer q);
pointer set_cdr(pointer p, pointer q);
int is_symbol(pointer p);
char *symname(pointer p);
int hasprop(pointer p);
int is_syntax(pointer p);
int is_proc(pointer p);
int is_foreign(pointer p);
char *syntaxname(pointer p);
int is_closure(pointer p);
#ifdef USE_MACRO
int is_macro(pointer p);
#endif
pointer closure_code(pointer p);
pointer closure_env(pointer p);
int is_continuation(pointer p);
int is_promise(pointer p);
int is_environment(pointer p);
int is_immutable(pointer p);
void setimmutable(pointer p);
int is_foreign_object(pointer p);
const foreign_object_vtable *get_foreign_object_vtable(pointer p);
void *get_foreign_object_data(pointer p);
#ifdef __cplusplus
}
#endif
#endif
/*
Local variables:
c-file-style: "k&r"
End:
*/