1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
|
/* scheme-private.h */
#ifndef _SCHEME_PRIVATE_H
#define _SCHEME_PRIVATE_H
#include "scheme.h"
/*------------------ Ugly internals -----------------------------------*/
/*------------------ Of interest only to FFI users --------------------*/
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 25000 /* # of cells in one segment */
#endif
#ifndef CELL_NSEGMENT
#define CELL_NSEGMENT 50 /* # of segments for cells */
#endif
char *alloc_seg[CELL_NSEGMENT];
pointer cell_seg[CELL_NSEGMENT];
int last_cell_seg;
/* We use 5 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 */
pointer foreign_error; /* used for foreign functions to signal an error */
int interactive_repl; /* are we in an interactive REPL? */
int print_output; /* set to 1 to print results and error messages */
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 1024
#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;
struct scheme_interface *vptr;
void *dump_base; /* pointer to base of allocated dump stack */
int dump_size; /* number of frames allocated for dump stack */
gunichar backchar[2];
int bc_flag;
};
/* operator code */
enum scheme_opcodes {
#define _OP_DEF(A,B,C,D,E,OP) OP,
#include "opdefines.h"
OP_MAXDEFINED
};
#ifdef __cplusplus
extern "C" {
#endif
#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);
int string_length(pointer p);
gunichar charvalue(pointer p);
int is_vector(pointer p);
int is_port(pointer p);
int is_inport(pointer p);
int is_outport(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);
char *symkey(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);
int is_macro(pointer p);
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);
#ifdef __cplusplus
}
#endif
#endif
/*
Local variables:
c-file-style: "k&r"
End:
*/
|
