Edinburgh Speech Tools  2.4-release
 All Classes Functions Variables Typedefs Enumerations Enumerator Friends Pages
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 
30 struct 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 
148 typedef struct obj* LISP;
149 typedef 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 
183 struct gen_readio
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 
191 struct repl_hooks
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) \
199 class CLASS *NAME(LISP x); \
200 int NAME##_p(LISP x); \
201 EST_Val est_val(const class CLASS *v); \
202 LISP siod(const class CLASS *v);
203 
204 /* Macro for defining new class as siod */
205 #define SIOD_REGISTER_CLASS(NAME,CLASS) \
206 class CLASS *NAME(LISP x) \
207 { \
208  return NAME(val(x)); \
209 } \
210  \
211 int 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  \
220 LISP 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) \
231 CLASS *NAME(LISP x); \
232 int NAME##_p(LISP x); \
233 EST_Val est_val(const CLASS *v); \
234 LISP siod(const CLASS *v);
235 
236 /* Macro for defining new class as siod */
237 #define SIOD_REGISTER_TYPE(NAME,CLASS) \
238 CLASS *NAME(LISP x) \
239 { \
240  return NAME(val(x)); \
241 } \
242  \
243 int 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  \
252 LISP 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) \
263 CLASS NAME(LISP x) \
264 { \
265  return NAME(val(x)); \
266 } \
267  \
268 int 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  \
277 LISP siod(const CLASS v) \
278 { \
279  if (v == 0) \
280  return NIL; \
281  else \
282  return siod(est_val(v)); \
283 } \
284 
285 #endif