Edinburgh Speech Tools 2.4-release
siod_defs.h
1/* Scheme In One Defun, but in C this time.
2
3 * COPYRIGHT (c) 1988-1994 BY *
4 * PARADIGM ASSOCIATES INCORPORATED, CAMBRIDGE, MASSACHUSETTS. *
5 * See the source file SLIB.C for more information. *
6
7*/
8
9/*************************************************************************/
10/* Author : Alan W Black */
11/* Date : March 1999 */
12/*-----------------------------------------------------------------------*/
13/* */
14/* Struct and macro definitions for SIOD */
15/* */
16/*=======================================================================*/
17#ifndef __EST_SIOD_DEFS_H__
18#define __EST_SIOD_DEFS_H__
19
20/* This states the default heap size is effective unset */
21/* The size if no heap is specified by a command argument, the */
22/* value of the environment variable SIODHEAPSIZE will be used */
23/* otherwise ACTUAL_DEFAULT_HEAP_SIZE is used. This is *not* */
24/* documented because environment variables can cause so many */
25/* problems I'd like to discourage this use unless absolutely */
26/* necessary. */
27#define DEFAULT_HEAP_SIZE -1
28#define ACTUAL_DEFAULT_HEAP_SIZE 210000
29
30struct obj
31{union {struct {struct obj * car;
32 struct obj * cdr;} cons;
33 struct {double data;} flonum;
34 struct {const char *pname;
35 struct obj * vcell;} symbol;
36 struct {const char *name;
37 struct obj * (*f)(void);} subr0;
38 struct {const char *name;
39 struct obj * (*f)(struct obj *);} subr1;
40 struct {const char *name;
41 struct obj * (*f)(struct obj *, struct obj *);} subr2;
42 struct {const char *name;
43 struct obj * (*f)(struct obj *, struct obj *, struct obj *);
44 } subr3;
45 struct {const char *name;
46 struct obj * (*f)(struct obj *, struct obj *,
47 struct obj *, struct obj *);
48 } subr4;
49 struct {const char *name;
50 struct obj * (*f)(struct obj **, struct obj **);} subrm;
51 struct {const char *name;
52 struct obj * (*f)(void *,...);} subr;
53 struct {struct obj *env;
54 struct obj *code;} closure;
55 struct {long dim;
56 long *data;} long_array;
57 struct {long dim;
58 double *data;} double_array;
59 struct {long dim;
60 char *data;} string;
61 struct {long dim;
62 struct obj **data;} lisp_array;
63 struct {FILE *f;
64 char *name;} c_file;
65 struct {EST_Val *v;} val;
66 struct {void *p;} user;
67}
68 storage_as;
69 char *pname; // This is currently only used by FLONM
70 short gc_mark;
71 short type;
72};
73
74#define CAR(x) ((*x).storage_as.cons.car)
75#define CDR(x) ((*x).storage_as.cons.cdr)
76#define PNAME(x) ((*x).storage_as.symbol.pname)
77#define VCELL(x) ((*x).storage_as.symbol.vcell)
78#define SUBR0(x) (*((*x).storage_as.subr0.f))
79#define SUBR1(x) (*((*x).storage_as.subr1.f))
80#define SUBR2(x) (*((*x).storage_as.subr2.f))
81#define SUBR3(x) (*((*x).storage_as.subr3.f))
82#define SUBR4(x) (*((*x).storage_as.subr4.f))
83#define SUBRM(x) (*((*x).storage_as.subrm.f))
84#define SUBRF(x) (*((*x).storage_as.subr.f))
85#define FLONM(x) ((*x).storage_as.flonum.data)
86#define FLONMPNAME(x) ((*x).pname)
87#define USERVAL(x) ((*x).storage_as.user.p)
88#define UNTYPEDVAL(x) ((*x).storage_as.user.p)
89
90#define NIL ((struct obj *) 0)
91#define EQ(x,y) ((x) == (y))
92#define NEQ(x,y) ((x) != (y))
93#define NULLP(x) EQ(x,NIL)
94#define NNULLP(x) NEQ(x,NIL)
95
96#define TYPE(x) (((x) == NIL) ? 0 : ((*(x)).type))
97
98#define TYPEP(x,y) (TYPE(x) == (y))
99#define NTYPEP(x,y) (TYPE(x) != (y))
100
101#define tc_nil 0
102#define tc_cons 1
103#define tc_flonum 2
104#define tc_symbol 3
105#define tc_subr_0 4
106#define tc_subr_1 5
107#define tc_subr_2 6
108#define tc_subr_3 7
109#define tc_lsubr 8
110#define tc_fsubr 9
111#define tc_msubr 10
112#define tc_closure 11
113#define tc_free_cell 12
114#define tc_string 13
115#define tc_double_array 14
116#define tc_long_array 15
117#define tc_lisp_array 16
118#define tc_c_file 17
119#define tc_untyped 18
120#define tc_subr_4 19
121
122#define tc_sys_1 31
123#define tc_sys_2 32
124#define tc_sys_3 33
125#define tc_sys_4 34
126#define tc_sys_5 35
127
128// older method for adding application specific types
129#define tc_application_1 41
130#define tc_application_2 42
131#define tc_application_3 43
132#define tc_application_4 44
133#define tc_application_5 45
134#define tc_application_6 46
135#define tc_application_7 47
136
137// Application specific types may be added using siod_register_user_type()
138// Will increment from tc_first_user_type to tc_table_dim
139#define tc_first_user_type 50
140
141#define tc_table_dim 100
142
143#define FO_fetch 127
144#define FO_store 126
145#define FO_list 125
146#define FO_listd 124
147
148typedef struct obj* LISP;
149typedef LISP (*SUBR_FUNC)(void);
150
151#define CONSP(x) TYPEP(x,tc_cons)
152#define FLONUMP(x) TYPEP(x,tc_flonum)
153#define SYMBOLP(x) TYPEP(x,tc_symbol)
154#define STRINGP(x) TYPEP(x,tc_string)
155
156#define NCONSP(x) NTYPEP(x,tc_cons)
157#define NFLONUMP(x) NTYPEP(x,tc_flonum)
158#define NSYMBOLP(x) NTYPEP(x,tc_symbol)
159
160// Not for the purists, but I find these more readable than the equivalent
161// code inline.
162
163#define CAR1(x) CAR(x)
164#define CDR1(x) CDR(x)
165#define CAR2(x) CAR(CDR1(x))
166#define CDR2(x) CDR(CDR1(x))
167#define CAR3(x) CAR(CDR2(x))
168#define CDR3(x) CDR(CDR2(x))
169#define CAR4(x) CAR(CDR3(x))
170#define CDR4(x) CDR(CDR3(x))
171#define CAR5(x) CAR(CDR4(x))
172#define CDR5(x) CDR(CDR4(x))
173
174#define LISTP(x) (NULLP(x) || CONSP(x))
175#define LIST1P(x) (CONSP(x) && NULLP(CDR(x)))
176#define LIST2P(x) (CONSP(x) && CONSP(CDR1(x)) && NULLP(CDR2(x)))
177#define LIST3P(x) (CONSP(x) && CONSP(CDR1(x)) && CONSP(CDR2(x)) && NULLP(CDR3(x)))
178#define LIST4P(x) (CONSP(x) && CONSP(CDR1(x)) && CONSP(CDR2(x)) && CONSP(CDR3(x)) && NULLP(CDR4(x)))
179#define LIST5P(x) (CONSP(x) && CONSP(CDR1(x)) && CONSP(CDR2(x)) && CONSP(CDR3(x)) && CONSP(CDR4(x)) && NULLP(CDR5(x)))
180
181#define MKPTR(x) (siod_make_ptr((void *)x))
182
184{int (*getc_fcn)(char *);
185 void (*ungetc_fcn)(int, char *);
186 char *cb_argument;};
187
188#define GETC_FCN(x) (*((*x).getc_fcn))((*x).cb_argument)
189#define UNGETC_FCN(c,x) (*((*x).ungetc_fcn))(c,(*x).cb_argument)
190
192{void (*repl_puts)(char *);
193 LISP (*repl_read)(void);
194 LISP (*repl_eval)(LISP);
195 void (*repl_print)(LISP);};
196
197/* Macro for defining new class as values public functions */
198#define SIOD_REGISTER_CLASS_DCLS(NAME,CLASS) \
199class CLASS *NAME(LISP x); \
200int NAME##_p(LISP x); \
201EST_Val est_val(const class CLASS *v); \
202LISP siod(const class CLASS *v);
203
204/* Macro for defining new class as siod */
205#define SIOD_REGISTER_CLASS(NAME,CLASS) \
206class CLASS *NAME(LISP x) \
207{ \
208 return NAME(val(x)); \
209} \
210 \
211int NAME##_p(LISP x) \
212{ \
213 if (val_p(x) && \
214 (val_type_##NAME == val(x).type())) \
215 return TRUE; \
216 else \
217 return FALSE; \
218} \
219 \
220LISP siod(const class CLASS *v) \
221{ \
222 if (v == 0) \
223 return NIL; \
224 else \
225 return siod(est_val(v)); \
226} \
227
228
229/* Macro for defining typedefed something as values public functions */
230#define SIOD_REGISTER_TYPE_DCLS(NAME,CLASS) \
231CLASS *NAME(LISP x); \
232int NAME##_p(LISP x); \
233EST_Val est_val(const CLASS *v); \
234LISP siod(const CLASS *v);
235
236/* Macro for defining new class as siod */
237#define SIOD_REGISTER_TYPE(NAME,CLASS) \
238CLASS *NAME(LISP x) \
239{ \
240 return NAME(val(x)); \
241} \
242 \
243int NAME##_p(LISP x) \
244{ \
245 if (val_p(x) && \
246 (val_type_##NAME == val(x).type())) \
247 return TRUE; \
248 else \
249 return FALSE; \
250} \
251 \
252LISP siod(const CLASS *v) \
253{ \
254 if (v == 0) \
255 return NIL; \
256 else \
257 return siod(est_val(v)); \
258} \
259
260
261/* Macro for defining function ptr as siod */
262#define SIOD_REGISTER_FUNCPTR(NAME,CLASS) \
263CLASS NAME(LISP x) \
264{ \
265 return NAME(val(x)); \
266} \
267 \
268int NAME##_p(LISP x) \
269{ \
270 if (val_p(x) && \
271 (val_type_##NAME == val(x).type())) \
272 return TRUE; \
273 else \
274 return FALSE; \
275} \
276 \
277LISP siod(const CLASS v) \
278{ \
279 if (v == 0) \
280 return NIL; \
281 else \
282 return siod(est_val(v)); \
283} \
284
285#endif
Definition: siod_defs.h:31