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