scheme-private.h

/* scheme-private.h */

#ifndef _SCHEME_PRIVATE_H
#define _SCHEME_PRIVATE_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;
#if SHOW_ERROR_LINE
			int curr_line;
			char *filename;
#endif
		} stdio;
		struct {
			char *start;
			char *past_the_end;
			char *curr;
		} string;
	} rep;
} port;

/* cell structure */
struct cell {
	unsigned int _flag;
	union {
		struct {
			char *_svalue;
			int _length;
		} _string;
		num _number;
		port *_port;
		foreign_func _ff;
		struct {
			struct cell *_car;
			struct cell *_cdr;
		} _cons;
	} _object;
};

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
#ifndef CELL_NSEGMENT
#define CELL_NSEGMENT 10 /* # of segments for cells */
#endif
	char *alloc_seg[CELL_NSEGMENT];
	pointer cell_seg[CELL_NSEGMENT];
	int last_cell_seg;

	/* 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 */

	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* */
	pointer COMPILE_HOOK; /* *compile-hook* */

	pointer free_cell; /* pointer to top of free cells */
	long fcells; /* # of free cells */

	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[STRBUFFSIZE];

	FILE *tmpfp;
	int tok;
	int print_flag;
	pointer value;
	int op;

	void *ext_data; /* For the benefit of foreign functions */
	long gensym_cnt;

	void *dump_base; /* pointer to base of allocated dump stack */
	int dump_size; /* number of frames allocated for dump stack */
};

/* operator code */
enum scheme_opcodes {
#define _OP_DEF(A, B, C, D, E, 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);

/* macros for cell operations */
#define typeflag(p) ((p)->_flag)
#define type(p) (typeflag(p) & T_MASKTYPE)
#define strvalue(p) ((p)->_object._string._svalue)
#define strlength(p) ((p)->_object._string._length)
#define ivalue_unchecked(p) ((p)->_object._number.value.ivalue)
#define rvalue_unchecked(p) ((p)->_object._number.value.rvalue)
#define set_num_integer(p) (p)->_object._number.is_fixnum = 1;
#define set_num_real(p) (p)->_object._number.is_fixnum = 0;
#define car(p) ((p)->_object._cons._car)
#define cdr(p) ((p)->_object._cons._cdr)
#define procnum(p) ivalue(p)

#define cont_dump(p) cdr(p)
#define setenvironment(p) typeflag(p) = T_ENVIRONMENT
#define is_atom(p) (typeflag(p) & T_ATOM)
#define setatom(p) typeflag(p) |= T_ATOM
#define clratom(p) typeflag(p) &= CLRATOM
#define is_mark(p) (typeflag(p) & MARK)
#define setmark(p) typeflag(p) |= MARK
#define clrmark(p) typeflag(p) &= UNMARK
#define caar(p) car(car(p))
#define cadr(p) car(cdr(p))
#define cdar(p) cdr(car(p))
#define cddr(p) cdr(cdr(p))
#define cadar(p) car(cdr(car(p)))
#define caddr(p) car(cdr(cdr(p)))
#define cdaar(p) cdr(car(car(p)))
#define cadaar(p) car(cdr(car(car(p))))
#define cadddr(p) car(cdr(cdr(cdr(p))))
#define cddddr(p) cdr(cdr(cdr(cdr(p))))

#ifdef __cplusplus
}
#endif

#endif

/*
Local variables:
c-file-style: "k&r"
End:
*/