microscheme/scheme-private.h

/*
 * µscheme
 *
 * Copyright (C) 2015 Marc Alexander Lehmann <uscheme@schmorp.de>
 *                 do as you want with this, attribution appreciated.
 */

/* 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;
  int16_t unget;
  union
  {
    struct
    {
      int 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
{
  union
  {
    struct
    {
      uint8_t *svalue;
      uint32_t length;
    } string;

    struct {
      struct cell **vvalue;
      uint32_t length;
    } vector;

    intptr_t ivalue;
#if USE_REAL
    double rvalue;
#endif

    port *port;

    foreign_func ff;

    struct
    {
      struct cell *car;
      struct cell *cdr;
    } cons;

  } object;

  uint8_t flag;
};

/* frequently accessed members are near the beginning, reducing codesize esp. on CISC */
struct scheme
{
  /* NIL is the most commonly accessed value */
  struct cell xNIL;           /* special cell representing empty cell */

  /* 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 xT;             /* special cell representing #t */
  struct cell xF;             /* special cell representing #f */
  struct cell xEOF_OBJ;       /* special cell representing end-of-file object */
  struct cell xsink;          /* when mem. alloc. fails */

  /* arrays for segments */
#ifndef CELL_SEGSIZE
# define CELL_SEGSIZE    128   /* # of cells in one segment */
#endif
#ifndef CELL_NSEGMENT
# define CELL_NSEGMENT   20     /* # of segments for cells */
#endif
  char *alloc_seg[CELL_NSEGMENT];
  pointer cell_seg[CELL_NSEGMENT];
  int cell_segsize[CELL_NSEGMENT];
  int last_cell_seg;

  int interactive_repl;       /* are we in an interactive REPL? */

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

  /* return code */
  int retcode;
  int tracing;

  pointer inport;
  pointer outport;
  pointer save_inport;
  pointer loadport;

#define MAXFIL 8
  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 */

#define LINESIZE 1024
  char linebuff[LINESIZE];
#define STRBUFFSIZE 256
  char strbuff[STRBUFFSIZE];

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

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

  struct scheme_interface *vptr;
  struct dump_stack_frame *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(func,name,minarity,maxarity,argtest,op) op,
#include "opdefines.h"
#undef OP_DEF
  OP_MAXDEFINED
};

typedef struct num num;

#define cons(a,b) xcons(SCHEME_A_ a,b,0)
#define immutable_cons(a,b) xcons(SCHEME_A_ a,b,1)

INTERFACE int is_string (pointer p);
INTERFACE char *string_value (pointer p);
INTERFACE int is_number (pointer p);
INTERFACE num nvalue (pointer p);
INTERFACE int is_integer (pointer p);
INTERFACE int is_real (pointer p);
INTERFACE int is_character (pointer p);
INTERFACE long charvalue (pointer p);
INTERFACE int is_vector (pointer p);

INTERFACE int is_port (pointer p);

INTERFACE int is_pair (pointer p);
INTERFACE pointer pair_car (pointer p);
INTERFACE pointer pair_cdr (pointer p);
INTERFACE void set_car (pointer p, pointer q);
INTERFACE void set_cdr (pointer p, pointer q);

INTERFACE int is_symbol (pointer p);
INTERFACE char *symname (pointer p);
INTERFACE int hasprop (pointer p);

INTERFACE int is_syntax (pointer p);
INTERFACE int is_proc (pointer p);
INTERFACE int is_foreign (pointer p);
INTERFACE char *syntaxname (pointer p);
INTERFACE int is_closure (pointer p);
#ifdef USE_MACRO
INTERFACE int is_macro (pointer p);
#endif
INTERFACE pointer closure_code (pointer p);
INTERFACE pointer closure_env (pointer p);

INTERFACE int is_continuation (pointer p);
INTERFACE int is_promise (pointer p);
INTERFACE int is_environment (pointer p);
INTERFACE int is_immutable (pointer p);
INTERFACE void setimmutable (pointer p);

#ifdef __cplusplus
}
#endif

#endif

/*
Local variables:
c-file-style: "k&r"
End:
*/
Revision:	1.8
Committed:	Mon Nov 30 07:44:23 2015 UTC (8 years, 6 months ago) by root
Content type:	text/plain
Branch:	MAIN
Changes since 1.7:	+1 -1 lines
Log Message:	* empty log message *
#	Content
1	/*
2	* µscheme
3	*
4	* Copyright (C) 2015 Marc Alexander Lehmann <uscheme@schmorp.de>
5	* do as you want with this, attribution appreciated.
6	*/
7
8	/* scheme-private.h */
9
10	#ifndef SCHEME_PRIVATE_H
11	#define SCHEME_PRIVATE_H
12
13	#include "scheme.h"
14
15	/------------------ Ugly internals -----------------------------------/
16
17	/------------------ Of interest only to FFI users --------------------/
18
19	# ifdef __cplusplus
20	extern "C"
21	{
22	# endif
23
24	enum scheme_port_kind
25	{
26	port_free = 0,
27	port_file = 1,
28	port_string = 2,
29	port_srfi6 = 4,
30	port_input = 16,
31	port_output = 32,
32	port_saw_EOF = 64
33	};
34
35	typedef struct port
36	{
37	unsigned char kind;
38	int16_t unget;
39	union
40	{
41	struct
42	{
43	int file;
44	int closeit;
45	# if SHOW_ERROR_LINE
46	int curr_line;
47	char *filename;
48	# endif
49	} stdio;
50	struct
51	{
52	char *start;
53	char *past_the_end;
54	char *curr;
55	} string;
56	} rep;
57	} port;
58
59	/* cell structure */
60	struct cell
61	{
62	union
63	{
64	struct
65	{
66	uint8_t *svalue;
67	uint32_t length;
68	} string;
69
70	struct {
71	struct cell **vvalue;
72	uint32_t length;
73	} vector;
74
75	intptr_t ivalue;
76	#if USE_REAL
77	double rvalue;
78	#endif
79
80	port *port;
81
82	foreign_func ff;
83
84	struct
85	{
86	struct cell *car;
87	struct cell *cdr;
88	} cons;
89
90	} object;
91
92	uint8_t flag;
93	};
94
95	/* frequently accessed members are near the beginning, reducing codesize esp. on CISC */
96	struct scheme
97	{
98	/* NIL is the most commonly accessed value */
99	struct cell xNIL; /* special cell representing empty cell */
100
101	/* We use 4 registers. */
102	pointer args; /* register for arguments of function */
103	pointer envir; /* stack register for current environment */
104	pointer code; /* register for current code */
105	pointer dump; /* stack register for next evaluation */
106
107	struct cell xT; /* special cell representing #t */
108	struct cell xF; /* special cell representing #f */
109	struct cell xEOF_OBJ; /* special cell representing end-of-file object */
110	struct cell xsink; /* when mem. alloc. fails */
111
112	/* arrays for segments */
113	#ifndef CELL_SEGSIZE
114	# define CELL_SEGSIZE 128 /* # of cells in one segment */
115	#endif
116	#ifndef CELL_NSEGMENT
117	# define CELL_NSEGMENT 20 /* # of segments for cells */
118	#endif
119	char *alloc_seg[CELL_NSEGMENT];
120	pointer cell_seg[CELL_NSEGMENT];
121	int cell_segsize[CELL_NSEGMENT];
122	int last_cell_seg;
123
124	int interactive_repl; /* are we in an interactive REPL? */
125
126	pointer oblist; /* pointer to symbol table */
127	pointer global_env; /* pointer to global environment */
128	pointer c_nest; /* stack for nested calls from C */
129
130	/* global pointers to special symbols */
131	pointer LAMBDA; /* pointer to syntax lambda */
132	pointer QUOTE; /* pointer to syntax quote */
133
134	pointer QQUOTE; /* pointer to symbol quasiquote */
135	pointer UNQUOTE; /* pointer to symbol unquote */
136	pointer UNQUOTESP; /* pointer to symbol unquote-splicing */
137	pointer FEED_TO; /* => */
138	pointer COLON_HOOK; /* colon-hook */
139	pointer ERROR_HOOK; /* error-hook */
140	pointer SHARP_HOOK; /* sharp-hook */
141	pointer COMPILE_HOOK; /* compile-hook */
142
143	pointer free_cell; /* pointer to top of free cells */
144	long fcells; /* # of free cells */
145
146	/* return code */
147	int retcode;
148	int tracing;
149
150	pointer inport;
151	pointer outport;
152	pointer save_inport;
153	pointer loadport;
154
155	#define MAXFIL 8
156	port load_stack[MAXFIL]; /* Stack of open files for port -1 (LOADing) */
157	int nesting_stack[MAXFIL];
158	int file_i;
159	int nesting;
160
161	char gc_verbose; /* if gc_verbose is not zero, print gc status */
162	char no_memory; /* Whether mem. alloc. has failed */
163
164	#define LINESIZE 1024
165	char linebuff[LINESIZE];
166	#define STRBUFFSIZE 256
167	char strbuff[STRBUFFSIZE];
168
169	int tmpfp;
170	int tok;
171	int print_flag;
172	pointer value;
173	int op;
174
175	void ext_data; / For the benefit of foreign functions */
176	long gensym_cnt;
177
178	struct scheme_interface *vptr;
179	struct dump_stack_frame dump_base; / pointer to base of allocated dump stack */
180	int dump_size; /* number of frames allocated for dump stack */
181	};
182
183	/* operator code */
184	enum scheme_opcodes
185	{
186	#define OP_DEF(func,name,minarity,maxarity,argtest,op) op,
187	#include "opdefines.h"
188	#undef OP_DEF
189	OP_MAXDEFINED
190	};
191
192	typedef struct num num;
193
194	#define cons(a,b) xcons(SCHEME_A_ a,b,0)
195	#define immutable_cons(a,b) xcons(SCHEME_A_ a,b,1)
196
197	INTERFACE int is_string (pointer p);
198	INTERFACE char *string_value (pointer p);
199	INTERFACE int is_number (pointer p);
200	INTERFACE num nvalue (pointer p);
201	INTERFACE int is_integer (pointer p);
202	INTERFACE int is_real (pointer p);
203	INTERFACE int is_character (pointer p);
204	INTERFACE long charvalue (pointer p);
205	INTERFACE int is_vector (pointer p);
206
207	INTERFACE int is_port (pointer p);
208
209	INTERFACE int is_pair (pointer p);
210	INTERFACE pointer pair_car (pointer p);
211	INTERFACE pointer pair_cdr (pointer p);
212	INTERFACE void set_car (pointer p, pointer q);
213	INTERFACE void set_cdr (pointer p, pointer q);
214
215	INTERFACE int is_symbol (pointer p);
216	INTERFACE char *symname (pointer p);
217	INTERFACE int hasprop (pointer p);
218
219	INTERFACE int is_syntax (pointer p);
220	INTERFACE int is_proc (pointer p);
221	INTERFACE int is_foreign (pointer p);
222	INTERFACE char *syntaxname (pointer p);
223	INTERFACE int is_closure (pointer p);
224	#ifdef USE_MACRO
225	INTERFACE int is_macro (pointer p);
226	#endif
227	INTERFACE pointer closure_code (pointer p);
228	INTERFACE pointer closure_env (pointer p);
229
230	INTERFACE int is_continuation (pointer p);
231	INTERFACE int is_promise (pointer p);
232	INTERFACE int is_environment (pointer p);
233	INTERFACE int is_immutable (pointer p);
234	INTERFACE void setimmutable (pointer p);
235
236	#ifdef __cplusplus
237	}
238	#endif
239
240	#endif
241
242	/*
243	Local variables:
244	c-file-style: "k&r"
245	End:
246	*/