2016-01-06 11:54:03 +01:00
|
|
|
/* scheme-private.h */
|
|
|
|
|
|
|
|
#ifndef _SCHEME_PRIVATE_H
|
|
|
|
#define _SCHEME_PRIVATE_H
|
|
|
|
|
2017-04-07 12:27:47 +02:00
|
|
|
#include <stdint.h>
|
2016-01-06 11:54:03 +01:00
|
|
|
#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;
|
2017-02-28 09:40:01 +01:00
|
|
|
#if SHOW_ERROR_LINE
|
|
|
|
pointer curr_line;
|
|
|
|
pointer filename;
|
|
|
|
#endif
|
2016-01-06 11:54:03 +01:00
|
|
|
} port;
|
|
|
|
|
|
|
|
/* cell structure */
|
|
|
|
struct cell {
|
2017-04-07 12:27:47 +02:00
|
|
|
uintptr_t _flag;
|
2016-01-06 11:54:03 +01:00
|
|
|
union {
|
2017-03-23 15:21:36 +01:00
|
|
|
num _number;
|
2016-01-06 11:54:03 +01:00
|
|
|
struct {
|
|
|
|
char *_svalue;
|
|
|
|
int _length;
|
|
|
|
} _string;
|
|
|
|
port *_port;
|
|
|
|
foreign_func _ff;
|
|
|
|
struct {
|
|
|
|
struct cell *_car;
|
|
|
|
struct cell *_cdr;
|
|
|
|
} _cons;
|
2017-01-30 15:51:19 +01:00
|
|
|
struct {
|
|
|
|
size_t _length;
|
|
|
|
pointer _elements[0];
|
|
|
|
} _vector;
|
2016-03-31 13:49:56 +02:00
|
|
|
struct {
|
|
|
|
char *_data;
|
|
|
|
const foreign_object_vtable *_vtable;
|
|
|
|
} _foreign_object;
|
2016-01-06 11:54:03 +01:00
|
|
|
} _object;
|
|
|
|
};
|
|
|
|
|
2016-11-18 10:58:18 +01:00
|
|
|
#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
|
|
|
|
|
2016-01-06 11:54:03 +01:00
|
|
|
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
|
2017-04-20 15:04:52 +02:00
|
|
|
|
|
|
|
/* 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
|
2017-03-22 16:22:57 +01:00
|
|
|
struct cell_segment *cell_segments;
|
2016-01-06 11:54:03 +01:00
|
|
|
|
|
|
|
/* 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 */
|
2017-04-06 11:52:36 +02:00
|
|
|
pointer frame_freelist;
|
2016-01-06 11:54:03 +01:00
|
|
|
|
2016-11-18 10:58:18 +01:00
|
|
|
#if USE_HISTORY
|
|
|
|
struct history history; /* we keep track of the call history for
|
|
|
|
* error messages */
|
|
|
|
#endif
|
|
|
|
|
2016-01-06 11:54:03 +01:00
|
|
|
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* */
|
2016-11-09 13:34:54 +01:00
|
|
|
#if USE_COMPILE_HOOK
|
2016-01-06 11:54:03 +01:00
|
|
|
pointer COMPILE_HOOK; /* *compile-hook* */
|
2016-11-09 13:34:54 +01:00
|
|
|
#endif
|
2016-01-06 11:54:03 +01:00
|
|
|
|
|
|
|
pointer free_cell; /* pointer to top of free cells */
|
|
|
|
long fcells; /* # of free cells */
|
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
|
2016-01-06 11:54:03 +01:00
|
|
|
|
|
|
|
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
|
2016-03-31 13:33:03 +02:00
|
|
|
char *strbuff;
|
|
|
|
size_t strbuff_size;
|
2016-01-06 11:54:03 +01:00
|
|
|
FILE *tmpfp;
|
|
|
|
int tok;
|
|
|
|
int print_flag;
|
|
|
|
pointer value;
|
2016-11-21 12:38:44 +01:00
|
|
|
unsigned int flags;
|
2016-01-06 11:54:03 +01:00
|
|
|
|
|
|
|
void *ext_data; /* For the benefit of foreign functions */
|
|
|
|
long gensym_cnt;
|
|
|
|
|
2017-03-23 12:50:27 +01:00
|
|
|
const struct scheme_interface *vptr;
|
2016-01-06 11:54:03 +01:00
|
|
|
};
|
|
|
|
|
|
|
|
/* operator code */
|
|
|
|
enum scheme_opcodes {
|
2017-03-29 14:11:58 +02:00
|
|
|
#define _OP_DEF(A,B,C,D,OP) OP,
|
2016-01-06 11:54:03 +01:00
|
|
|
#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);
|
|
|
|
|
2016-03-31 13:49:56 +02:00
|
|
|
int is_foreign_object(pointer p);
|
|
|
|
const foreign_object_vtable *get_foreign_object_vtable(pointer p);
|
|
|
|
void *get_foreign_object_data(pointer p);
|
|
|
|
|
2016-01-06 11:54:03 +01:00
|
|
|
#ifdef __cplusplus
|
|
|
|
}
|
|
|
|
#endif
|
|
|
|
|
|
|
|
#endif
|
|
|
|
|
|
|
|
/*
|
|
|
|
Local variables:
|
|
|
|
c-file-style: "k&r"
|
|
|
|
End:
|
|
|
|
*/
|