git @ Cat's Eye Technologies Bhuna / 101565f
Import of Bhuna 0.5 sources. catseye 11 years ago
102 changed file(s) with 7155 addition(s) and 7445 deletion(s). Raw diff Collapse all Expand all
+2
-0
doc/acktime less more
0 Ack(3,7): 1021
1 1.178u 0.000s 0:01.18 99.1% 30+1092k 0+0io 0pf+0w
+2
-0
doc/acktime2 less more
0 Ack(3,7): 1021
1 1.320u 0.000s 0:01.33 99.2% 46+1090k 0+0io 0pf+0w
+2
-0
doc/acktime3 less more
0 Ack(3,7): 1021
1 0.818u 0.000s 0:00.83 97.5% 36+1224k 0+0io 0pf+0w
+19
-0
eg/a7.bhu less more
0 // Ackermann function. Derived from:
1 // $Id: ackermann.lua.html,v 1.5 2004/07/03 07:11:33 bfulgham Exp $
2 // http://www.bagley.org/~doug/shootout/
3
4 Ack = ^ M,N {
5 if M = 0
6 return N + 1
7 else if N = 0
8 return Ack(M - 1, 1)
9 else
10 return Ack(M - 1, Ack(M, (N - 1)))
11 }
12
13 I = 5
14 while I > 0 {
15 Num = 7
16 Print "Ack(3,", Num, "): ", Ack(3, Num), EoL
17 I = I - 1
18 }⏎
+15
-0
eg/ack9.bhu less more
0 // Ackermann function. Derived from:
1 // $Id: ackermann.lua.html,v 1.5 2004/07/03 07:11:33 bfulgham Exp $
2 // http://www.bagley.org/~doug/shootout/
3
4 Ack = ^ M,N {
5 if M = 0
6 return N + 1
7 else if N = 0
8 return Ack(M - 1, 1)
9 else
10 return Ack(M - 1, Ack(M, (N - 1)))
11 }
12
13 Num = 9
14 Print "Ack(3,", Num, "): ", Ack(3, Num), EoL
+1
-0
eg/assoc.bhu less more
0 Print 12 / (6 / 2)
+17
-0
eg/fibspawn.bhu less more
0 Fib = ^ X {
1 if X > 2
2 return Fib(X - 1) + Fib(X - 2)
3 else
4 return 1
5 }
6
7 MakeFibPrinter = ^ X {
8 return ^ { Print "Fib(", X, ")=", Fib(X), EoL }
9 }
10
11 I = 1
12 while I <= 25 {
13 Q = MakeFibPrinter(I)
14 Spawn Q
15 I = I + 1
16 }
+5
-0
eg/import.bhu less more
0 import "modules/io"
1
2 // Print "Hello", EoL
3
4 Hello 42
+27
-0
eg/mtr.bhu less more
0 // mutual tail recursion.
1
2 // dummy function to get decls/type checking OK
3
4 F = ^ A { return A }
5
6 G = ^ A, B {
7 if A > 0 {
8 Print "In G, A = ", A, " and B = ", B, EoL
9 return F(A-1)
10 } else {
11 Print "End of G", EoL
12 return 0
13 }
14 }
15
16 F = ^ A {
17 if A > 0 {
18 Print "In F, A = ", A, EoL
19 return G(A-1, A+1)
20 } else {
21 Print "End of F", EoL
22 return 0
23 }
24 }
25
26 Print "F(100000)=", F(100000), EoL
+15
-0
eg/share2.bhu less more
0 A = [1, 2, 3]
1 B = A
2
3 PrintAB = ^ {
4 Print "A = ", A, EoL
5 Print "B = ", B, EoL
6 }
7
8 PrintAB;
9
10 B[2] = ["zing", "zang", "bar"]
11 PrintAB;
12
13 B[2][2] = "foo"
14 PrintAB;
+8
-0
eg/share3.bhu less more
0 A = [1, 2, 3]
1 I = 10
2 while I > 0 {
3 A[2] = I
4 Print A, EoL
5 I = I - 1
6 }
7
+13
-0
eg/spawn.bhu less more
0 F = ^ {
1 I = 10
2 while I > 0 {
3 Print "F was spawned!", EoL
4 I = I - 1
5 }
6 }
7
8 Print "Spawning F..."
9
10 Spawn F
11
12 Print "hello", EoL
+8
-0
eg/tri3.bhu less more
0 A = 1
1 T = A
2 T = 2
3 Print "A=",A," T=",T, EoL
4 A = 57
5 Print "A=",A," T=",T, EoL
6 T = 1
7 Print "A=",A," T=",T, EoL
+6
-36
src/Makefile less more
0 PROG= bhuna
1 SRCS= report.c \
2 scan.c parse.c \
3 symbol.c ast.c \
4 type.c \
5 mem.c pool.c \
6 list.c atom.c buffer.c closure.c dict.c value.c \
7 activation.c eval.c \
8 gen.c vm.c \
9 builtin.c \
10 main.c
0 SUBDIR=lib modules driver
111
12 CFLAGS+=-DPOOL_VALUES
13 CFLAGS+=-DREFCOUNTING_MACROS
14 CFLAGS+=-DINLINE_BUILTINS
15 CFLAGS+=-Wall -I/usr/local/include
16 .ifndef NODEBUG
17 CFLAGS+=-g -DDEBUG
18 .else
19 CFLAGS+=-DNDEBUG
20 .endif
2 strip:
3 ( cd lib && make strip )
4 ( cd modules && make strip )
5 ( cd driver && make strip )
216
22 .ifdef OPTIMIZED
23 CFLAGS+=-O2 -finline-functions
24 .endif
25 .ifdef PROFILED
26 CFLAGS+=-pg
27 .endif
28
29 NOMAN= y
30
31 # DESTDIR=/usr/local/sbin
32 strip: bhuna
33 strip bhuna
34 ls -lah bhuna
35 ls -la bhuna
36
37 .include <bsd.prog.mk>
7 .include <bsd.subdir.mk>
+20
-0
src/Makefile.inc less more
0 #CFLAGS+=-DPOOL_VALUES
1 CFLAGS+=-DHASH_CONSING
2 CFLAGS+=-DINLINE_BUILTINS
3 CFLAGS+=-Wall
4
5 #-I/usr/local/include
6
7 .ifndef NODEBUG
8 CFLAGS+=-g -DDEBUG
9 .else
10 CFLAGS+=-DNDEBUG
11 .endif
12
13 .ifdef OPTIMIZED
14 CFLAGS+=-Os -finline-functions
15 .endif
16
17 .ifdef PROFILED
18 CFLAGS+=-pg
19 .endif
+0
-2
src/acktime less more
0 Ack(3,7): 1021
1 1.178u 0.000s 0:01.18 99.1% 30+1092k 0+0io 0pf+0w
+0
-2
src/acktime2 less more
0 Ack(3,7): 1021
1 1.320u 0.000s 0:01.33 99.2% 46+1090k 0+0io 0pf+0w
+0
-348
src/activation.c less more
0 #include <assert.h>
1 #include <stdlib.h>
2 #include <stdio.h>
3 #include <string.h>
4
5 #include "mem.h"
6 #include "activation.h"
7 #include "value.h"
8 #include "list.h"
9 #include "closure.h"
10
11 #define VALARY(a,i) \
12 ((struct value **)((char *)a + sizeof(struct activation)))[i]
13
14 #ifdef DEBUG
15 extern int trace_activations;
16 extern int activations_allocated;
17 extern int activations_freed;
18 #endif
19
20 extern struct activation *current_ar;
21 extern int gc_trigger;
22 extern int gc_target;
23
24 static struct activation *a_head = NULL;
25 static int a_count = 0;
26
27 #define A_STACK_SIZE 65536
28
29 unsigned char a_stack[A_STACK_SIZE];
30 unsigned char *a_sp = a_stack;
31
32 struct activation *
33 activation_new_on_heap(int size, struct activation *caller, struct activation *enclosing)
34 {
35 struct activation *a;
36
37 if (a_count > gc_target) {
38 /*printf("GC!\n");*/
39 #ifdef DEBUG
40 if (trace_activations > 1) {
41 printf("[ARC] GARBAGE COLLECTION STARTED on %d activation records!!!\n",
42 a_count);
43 activation_dump(current_ar, 0);
44 printf("\n");
45 }
46 #endif
47 activation_gc();
48 #ifdef DEBUG
49 if (trace_activations > 1) {
50 printf("[ARC] GARBAGE COLLECTION FINISHED, now %d activation records!!!\n",
51 a_count);
52 activation_dump(current_ar, 0);
53 printf("\n");
54 }
55 #endif
56 /*
57 * Slide the target to account for the fact that there
58 * are now 'a_count' activation records in existence.
59 * Only GC when there are gc_trigger *more* ar's.
60 */
61 gc_target = a_count + gc_trigger;
62 }
63
64 a = bhuna_malloc(sizeof(struct activation) +
65 sizeof(struct value *) * size);
66 /*bzero(a, sizeof(struct activation) +
67 sizeof(struct value *) * size);*/
68 a->size = size;
69 a->caller = caller;
70 a->enclosing = enclosing;
71 a->marked = 0;
72
73 /*
74 * Link up to our GC list.
75 */
76 a->next = a_head;
77 a_head = a;
78
79 #ifdef DEBUG
80 if (trace_activations > 1) {
81 printf("[ARC] created on HEAP");
82 activation_dump(a, -1);
83 printf("\n");
84 }
85 activations_allocated++;
86 #endif
87
88 a_count++;
89 return(a);
90 }
91
92 struct activation *
93 activation_new_on_stack(int size, struct activation *caller, struct activation *enclosing)
94 {
95 struct activation *a;
96
97 a = (struct activation *)a_sp;
98 a_sp += sizeof(struct activation) + sizeof(struct value *) * size;
99
100 a->size = size;
101 a->caller = caller;
102 a->enclosing = enclosing;
103
104 #ifdef DEBUG
105 if (trace_activations > 1) {
106 printf("[ARC] created on STACK ");
107 activation_dump(a, -1);
108 printf("\n");
109 }
110 activations_allocated++;
111 #endif
112
113 return(a);
114 }
115
116 void
117 activation_free_from_heap(struct activation *a)
118 {
119 int i;
120
121 #ifdef DEBUG
122 if (trace_activations > 1) {
123 printf("[ARC] freeing from HEAP ");
124 activation_dump(a, -1);
125 printf("\n");
126 }
127 activations_freed++;
128 #endif
129
130 for (i = 0; i < a->size; i++)
131 value_release(VALARY(a, i));
132
133 bhuna_free(a);
134 a_count--;
135 }
136
137 int
138 activation_is_on_stack(struct activation *a)
139 {
140 return ((unsigned char *)a >= a_stack &&
141 (unsigned char *)a < (a_stack + A_STACK_SIZE));
142 }
143
144 void
145 activation_free_from_stack(struct activation *a)
146 {
147 int i;
148
149 #ifdef DEBUG
150 if (trace_activations > 1) {
151 printf("[ARC] freeing from STACK ");
152 activation_dump(a, -1);
153 printf("\n");
154 }
155 activations_freed++;
156 #endif
157
158 for (i = 0; i < a->size; i++)
159 value_release(VALARY(a, i));
160
161 a_sp -= (sizeof(struct activation) + sizeof(struct value *) * a->size);
162 }
163
164 /*#ifndef REFCOUNTING_MACROS*/
165 struct value *
166 activation_get_value(struct activation *a, int index, int upcount)
167 {
168 assert(a != NULL);
169 for (; upcount > 0; upcount--) {
170 a = a->enclosing;
171 assert(a != NULL);
172 }
173 #ifdef DEBUG
174 assert(index < a->size);
175 #endif
176 return(((struct value **)((char *)a + sizeof(struct activation)))[index]);
177 }
178
179 void
180 activation_set_value(struct activation *a, int index, int upcount,
181 struct value *v)
182 {
183 assert(a != NULL);
184 for (; upcount > 0; upcount--) {
185 a = a->enclosing;
186 assert(a != NULL);
187 }
188
189 #ifdef DEBUG
190 /*
191 printf("set: index = %d, a->size = %d in \n", index, a->size);
192 activation_dump(a, 1);
193 printf("\n");
194 */
195 assert(index < a->size);
196 #endif
197 value_release(VALARY(a, index));
198 value_grab(v);
199 VALARY(a, index) = v;
200 }
201
202 void
203 activation_initialize_value(struct activation *a, int index,
204 struct value *v)
205 {
206 assert(a != NULL);
207 assert(index < a->size);
208 value_grab(v);
209 VALARY(a, index) = v;
210 }
211 /*#endif*/
212
213 void
214 activation_dump(struct activation *a, int detail)
215 {
216 #ifdef DEBUG
217 int i;
218
219 printf("A/");
220 if (a == NULL) {
221 printf("(NULL)/");
222 return;
223 }
224 printf("%08lx:%d", (unsigned long)a, a->size);
225
226 if (detail > 0) {
227 for (i = 0; i < a->size; i++) {
228 printf(" ");
229 if (VALARY(a, i) != NULL && VALARY(a, i)->type == VALUE_CLOSURE) {
230 printf("(closure) ");
231 } else {
232 value_print(VALARY(a, i));
233 }
234 }
235 }
236
237 if (a->enclosing != NULL) {
238 printf(" --> {");
239 activation_dump(a->enclosing, 0);
240 printf("}");
241 }
242 if (a->caller != NULL) {
243 printf(" +++> {");
244 activation_dump(a->caller, 0);
245 printf("}");
246 }
247 printf("/");
248 #endif
249 }
250
251 /*
252 * Garbage collector. Not just the cheesy little reference counter, but
253 * the real meat-and-potatoes mark-and-sweep. (Which we need,
254 * because an activation record can contain a closure which contain
255 * an activation record, and refcounts can't handle that cycle.)
256 *
257 * This is not particularly sophisticated; I'm more concerned with
258 * correctness than performance here.
259 */
260 static void activation_mark(struct activation *a);
261
262 static void
263 value_mark(struct value *v)
264 {
265 struct list *l;
266
267 if (v == NULL)
268 return;
269 switch (v->type) {
270 case VALUE_LIST:
271 for (l = v->v.l; l != NULL; l = l->next) {
272 value_mark(l->value);
273 }
274 break;
275 case VALUE_CLOSURE:
276 activation_mark(v->v.k->ar);
277 break;
278 case VALUE_DICT:
279 /* XXX for each key in v->v.d, value_mark(d[k]) */
280 break;
281 default:
282 /*
283 * No need to go through other values as they
284 * are not containers.
285 */
286 break;
287 }
288 }
289
290 static void
291 activation_mark(struct activation *a)
292 {
293 int i;
294
295 if (a == NULL || a->marked)
296 return;
297
298 #ifdef DEBUG
299 if (trace_activations > 1) {
300 printf("[GC] MARKING AS REACHABLE: ");
301 activation_dump(a, 0);
302 printf("\n");
303 }
304 #endif
305
306 a->marked = 1;
307 activation_mark(a->caller);
308 activation_mark(a->enclosing);
309 for (i = 0; i < a->size; i++) {
310 value_mark(VALARY(a, i));
311 }
312 }
313
314 void
315 activation_gc(void)
316 {
317 struct activation *a, *next;
318 struct activation *t_head = NULL;
319
320 /*
321 * Mark...
322 */
323 activation_mark(current_ar);
324
325 /*
326 * ...and sweep
327 */
328 for (a = a_head; a != NULL; a = next) {
329 next = a->next;
330 if (a->marked) {
331 a->marked = 0;
332 a->next = t_head;
333 t_head = a;
334 } else {
335 #ifdef DEBUG
336 if (trace_activations > 1) {
337 printf("[GC] FOUND UNREACHABLE: ");
338 activation_dump(a, 0);
339 printf("\n");
340 }
341 #endif
342 activation_free_from_heap(a);
343 }
344 }
345
346 a_head = t_head;
347 }
+0
-34
src/activation.h less more
0 #define DEFAULT_GC_TRIGGER 512
1
2 struct value;
3
4 /*
5 * Structure of an activation record.
6 * This is actually only the header;
7 * the frame itself (containing local variables)
8 * follows immediately in memory.
9 */
10 struct activation {
11 struct activation *next; /* global list of all act recs */
12 int marked;
13 int size;
14 struct activation *caller; /* recursively shallower activation record */
15 struct activation *enclosing; /* lexically enclosing activation record */
16 /*
17 struct value *value[];
18 */
19 };
20
21 struct activation *activation_new_on_heap(int, struct activation *, struct activation *);
22 struct activation *activation_new_on_stack(int, struct activation *, struct activation *);
23 int activation_is_on_stack(struct activation *);
24 void activation_free_from_heap(struct activation *);
25 void activation_free_from_stack(struct activation *);
26
27 struct value *activation_get_value(struct activation *, int, int);
28 void activation_set_value(struct activation *, int, int, struct value *);
29 void activation_initialize_value(struct activation *, int, struct value *);
30
31 void activation_dump(struct activation *, int);
32
33 void activation_gc(void);
+0
-606
src/ast.c less more
0 #include <stdio.h>
1 #include <stdlib.h>
2 #include <string.h>
3
4 #include "ast.h"
5 #include "list.h"
6 #include "value.h"
7 #include "builtin.h"
8 #include "activation.h"
9 #include "vm.h"
10 #include "type.h"
11 #include "scan.h"
12
13 #include "symbol.h"
14
15 extern unsigned char program[];
16 extern int trace_type_inference;
17
18 /***** constructors *****/
19
20 struct ast *
21 ast_new(int type)
22 {
23 struct ast *a;
24
25 a = malloc(sizeof(struct ast));
26 a->type = type;
27 a->sc = NULL;
28 a->label = NULL;
29 a->datatype = NULL;
30
31 return(a);
32 }
33
34 struct ast *
35 ast_new_local(struct symbol_table *stab, struct symbol *sym)
36 {
37 struct ast *a;
38
39 a = ast_new(AST_LOCAL);
40 a->u.local.index = sym->index;
41 a->u.local.upcount = stab->level - sym->in->level;
42 a->u.local.sym = sym;
43 a->datatype = sym->type;
44
45 #ifdef DEBUG
46 if (trace_type_inference) {
47 printf("(new-local)*****\n");
48 printf("type is: ");
49 type_print(stdout, a->datatype);
50 printf("\n*******\n");
51 }
52 #endif
53
54 return(a);
55 }
56
57 struct ast *
58 ast_new_value(struct value *v, struct type *t)
59 {
60 struct ast *a;
61
62 a = ast_new(AST_VALUE);
63 value_grab(v);
64 a->u.value.value = v;
65 a->datatype = t;
66
67 #ifdef DEBUG
68 if (trace_type_inference) {
69 printf("(value)*****\n");
70 printf("type is: ");
71 type_print(stdout, a->datatype);
72 printf("\n*******\n");
73 }
74 #endif
75
76 return(a);
77 }
78
79 struct ast *
80 ast_new_builtin(struct scan_st *sc, struct builtin *bi, struct ast *right)
81 {
82 struct ast *a;
83 struct type *t;
84 int unify = 0;
85
86 t = bi->ty();
87 type_ensure_routine(t);
88
89 #ifdef DEBUG
90 if (trace_type_inference) {
91 printf("(builtin `%s`)*****\n", bi->name);
92 printf("type of args is: ");
93 type_print(stdout, right->datatype);
94 printf("\ntype of builtin is: ");
95 type_print(stdout, t);
96 }
97 #endif
98
99 unify = type_unify_crit(sc,
100 type_representative(t)->t.closure.domain,
101 right->datatype);
102
103 #ifdef DEBUG
104 if (trace_type_inference) {
105 printf("\nthese unify? --> %d <--", unify);
106 printf("\n****\n");
107 }
108 #endif
109
110 /*
111 * Fold constants.
112 */
113 if (bi->is_pure && ast_is_constant(right)) {
114 struct value *v = NULL;
115 struct activation *ar;
116 struct ast *g;
117 int i = 0;
118 int varity;
119
120 if (bi->arity == -1) {
121 varity = ast_count_args(right);
122 } else {
123 varity = bi->arity;
124 }
125
126 if (unify) {
127 ar = activation_new_on_stack(varity, NULL, NULL);
128 for (g = right, i = 0;
129 g != NULL && g->type == AST_ARG && i < varity;
130 g = g->u.arg.right, i++) {
131 if (g->u.arg.left != NULL)
132 activation_initialize_value(ar, i,
133 g->u.arg.left->u.value.value);
134 }
135 bi->fn(ar, &v);
136 activation_free_from_stack(ar);
137 } else {
138 a = NULL;
139 }
140
141 a = ast_new_value(v, type_representative(t)->t.closure.range);
142 value_release(v);
143
144 return(a);
145 }
146
147 a = ast_new(AST_BUILTIN);
148
149 a->u.builtin.bi = bi;
150 a->u.builtin.right = right;
151 a->datatype = type_representative(t)->t.closure.range;
152
153 return(a);
154 }
155
156 struct ast *
157 ast_new_apply(struct scan_st *sc, struct ast *fn, struct ast *args, int is_pure)
158 {
159 struct ast *a;
160 int unify;
161
162 a = ast_new(AST_APPLY);
163 a->u.apply.left = fn;
164 a->u.apply.right = args;
165 a->u.apply.is_pure = is_pure;
166
167 type_ensure_routine(fn->datatype);
168
169 #ifdef DEBUG
170 if (trace_type_inference) {
171 printf("(apply)*****\n");
172 printf("type of args is: ");
173 if (args == NULL) printf("N/A"); else type_print(stdout, args->datatype);
174 printf("\ntype of closure is: ");
175 type_print(stdout, fn->datatype);
176 }
177 #endif
178
179 if (args == NULL) {
180 unify = type_unify_crit(sc,
181 type_representative(fn->datatype)->t.closure.domain,
182 type_new(TYPE_VOID)); /* XXX need not be new */
183 } else {
184 unify = type_unify_crit(sc,
185 type_representative(fn->datatype)->t.closure.domain,
186 args->datatype);
187 }
188
189 #ifdef DEBUG
190 if (trace_type_inference) {
191 printf("\nthese unify? --> %d <--", unify);
192 printf("\n****\n");
193 }
194 #endif
195
196 a->datatype = type_representative(fn->datatype)->t.closure.range;
197
198 return(a);
199 }
200
201 struct ast *
202 ast_new_arg(struct ast *left, struct ast *right)
203 {
204 struct ast *a;
205
206 a = ast_new(AST_ARG);
207 a->u.arg.left = left;
208 a->u.arg.right = right;
209 if (a->u.arg.right == NULL) {
210 a->datatype = a->u.arg.left->datatype;
211 } else {
212 a->datatype = type_new_arg(
213 a->u.arg.left->datatype,
214 a->u.arg.right->datatype);
215 }
216 return(a);
217 }
218
219 struct ast *
220 ast_new_routine(int arity, int locals, int cc, struct ast *body)
221 {
222 struct ast *a;
223
224 a = ast_new(AST_ROUTINE);
225 a->u.routine.arity = arity;
226 a->u.routine.locals = locals;
227 a->u.routine.cc = cc;
228 a->u.routine.body = body;
229
230 a->datatype = a->u.routine.body->datatype;
231
232 #ifdef DEBUG
233 if (trace_type_inference) {
234 printf("(routine)*****\n");
235 printf("type is: ");
236 type_print(stdout, a->datatype);
237 printf("\n****\n");
238 }
239 #endif
240
241 return(a);
242 }
243
244 struct ast *
245 ast_new_statement(struct ast *left, struct ast *right)
246 {
247 struct ast *a;
248
249 if (left == NULL && right == NULL)
250 return(NULL);
251 if (left == NULL)
252 return(right);
253 if (right == NULL)
254 return(left);
255
256 a = ast_new(AST_STATEMENT);
257 a->u.statement.left = left;
258 a->u.statement.right = right;
259 /* XXX check that a->u.statement.left->datatype is VOID ?? */
260 a->datatype = a->u.statement.right->datatype;
261 /* haha... */
262 /*
263 a->datatype = type_new_set(a->u.statement.left->datatype,
264 a->u.statement.right->datatype);
265 */
266
267 #ifdef DEBUG
268 if (trace_type_inference) {
269 printf("(statement)*****\n");
270 printf("type is: ");
271 type_print(stdout, a->datatype);
272 printf("\n****\n");
273 }
274 #endif
275
276 return(a);
277 }
278
279 struct ast *
280 ast_new_assignment(struct scan_st *sc, struct ast *left, struct ast *right)
281 {
282 struct ast *a;
283 int unify;
284
285 /*
286 * Do some 'self-repairing' in the case of syntax errors that
287 * generate a corrupt AST (e.g. Foo = <eof>)
288 */
289 if (right == NULL)
290 return(left);
291
292 a = ast_new(AST_ASSIGNMENT);
293 a->u.assignment.left = left;
294 a->u.assignment.right = right;
295
296 unify = type_unify_crit(sc, left->datatype, right->datatype);
297
298 #ifdef DEBUG
299 if (trace_type_inference) {
300 printf("(assign)*****\n");
301 printf("type of LHS is: ");
302 type_print(stdout, left->datatype);
303 printf("\ntype of RHS is: ");
304 type_print(stdout, right->datatype);
305 printf("\nthese unify? --> %d <--", unify);
306 printf("\ntype of LHS is now: ");
307 type_print(stdout, left->datatype);
308 printf("\n****\n");
309 }
310 #endif
311
312 return(a);
313 }
314
315 struct ast *
316 ast_new_conditional(struct scan_st *sc, struct ast *test, struct ast *yes, struct ast *no)
317 {
318 struct ast *a;
319 int unify;
320
321 a = ast_new(AST_CONDITIONAL);
322 a->u.conditional.test = test;
323 a->u.conditional.yes = yes;
324 a->u.conditional.no = no;
325 /* check that a->u.conditional.test is BOOLEAN */
326
327 /* XXX need not be new boolean - reuse an old one */
328 unify = type_unify_crit(sc, test->datatype, type_new(TYPE_BOOLEAN));
329
330 #ifdef DEBUG
331 if (trace_type_inference) {
332 printf("(if)*****\n");
333 printf("type of YES is: ");
334 type_print(stdout, yes->datatype);
335 printf("\ntype of NO is: ");
336 type_print(stdout, no->datatype);
337 }
338 #endif
339
340 /* XXX check that a->u.conditional.yes is VOID */
341 /* XXX check that a->u.conditional.no is VOID */
342
343 /* actually, either of these can be VOID, in which case, pick the other */
344 /* unify = type_unify_crit(sc, yes->datatype, no->datatype); */
345 /* haha */
346 a->datatype = type_new_set(a->u.conditional.yes->datatype,
347 a->u.conditional.no->datatype);
348
349 #ifdef DEBUG
350 if (trace_type_inference) {
351 printf("\nresult type is: ");
352 type_print(stdout, a->datatype);
353 printf("\n****\n");
354 }
355 #endif
356
357 return(a);
358 }
359
360 struct ast *
361 ast_new_while_loop(struct scan_st *sc, struct ast *test, struct ast *body)
362 {
363 struct ast *a;
364 int unify;
365
366 a = malloc(sizeof(struct ast));
367 a->type = AST_WHILE_LOOP;
368
369 a->u.while_loop.test = test;
370 a->u.while_loop.body = body;
371 /* XXX need not be new boolean - reuse an old one */
372 unify = type_unify_crit(sc, test->datatype, type_new(TYPE_BOOLEAN));
373
374 /* XXX check that a->u.while_loop.body is VOID */
375 /* a->datatype = type_new(TYPE_VOID); */
376 a->datatype = body->datatype;
377
378 return(a);
379 }
380
381 struct ast *
382 ast_new_retr(struct ast *body)
383 {
384 struct ast *a;
385
386 a = ast_new(AST_RETR);
387 a->u.retr.body = body;
388 /* XXX check against other return statements in same function... somehow... */
389 a->datatype = a->u.retr.body->datatype;
390
391 #ifdef DEBUG
392 if (trace_type_inference) {
393 printf("(retr)*****\n");
394 printf("type is: ");
395 type_print(stdout, a->datatype);
396 printf("\n****\n");
397 }
398 #endif
399
400 return(a);
401 }
402
403 /*** DESTRUCTOR ***/
404
405 void
406 ast_free(struct ast *a)
407 {
408 if (a == NULL) {
409 return;
410 }
411 switch (a->type) {
412 case AST_LOCAL:
413 break;
414 case AST_VALUE:
415 value_release(a->u.value.value);
416 break;
417 case AST_BUILTIN:
418 ast_free(a->u.builtin.right);
419 break;
420 case AST_APPLY:
421 ast_free(a->u.apply.left);
422 ast_free(a->u.apply.right);
423 break;
424 case AST_ARG:
425 ast_free(a->u.arg.left);
426 ast_free(a->u.arg.right);
427 break;
428 case AST_ROUTINE:
429 ast_free(a->u.routine.body);
430 break;
431 case AST_STATEMENT:
432 ast_free(a->u.statement.left);
433 ast_free(a->u.statement.right);
434 break;
435 case AST_ASSIGNMENT:
436 ast_free(a->u.assignment.left);
437 ast_free(a->u.assignment.right);
438 break;
439 case AST_CONDITIONAL:
440 ast_free(a->u.conditional.test);
441 ast_free(a->u.conditional.yes);
442 ast_free(a->u.conditional.no);
443 break;
444 case AST_WHILE_LOOP:
445 ast_free(a->u.while_loop.test);
446 ast_free(a->u.while_loop.body);
447 break;
448 case AST_RETR:
449 ast_free(a->u.retr.body);
450 break;
451 }
452 if (a->sc != NULL)
453 scan_close(a->sc);
454 free(a);
455 }
456
457 /*** PREDICATES &c. ***/
458
459 int
460 ast_is_constant(struct ast *a)
461 {
462 if (a == NULL)
463 return(1);
464 switch (a->type) {
465 case AST_VALUE:
466 return(1);
467 case AST_ARG:
468 return(ast_is_constant(a->u.arg.left) &&
469 ast_is_constant(a->u.arg.right));
470 }
471 return(0);
472 }
473
474 int
475 ast_count_args(struct ast *a)
476 {
477 int ac;
478
479 for (ac = 0; a != NULL && a->type == AST_ARG; a = a->u.arg.right, ac++)
480 ;
481
482 return(ac);
483 }
484
485 /*** DEBUGGING ***/
486
487 char *
488 ast_name(struct ast *a)
489 {
490 #ifdef DEBUG
491 if (a == NULL)
492 return("(null)");
493 switch (a->type) {
494 case AST_LOCAL:
495 return("AST_LOCAL");
496 case AST_VALUE:
497 return("AST_VALUE");
498 case AST_BUILTIN:
499 return("AST_BUILTIN");
500 case AST_APPLY:
501 return("AST_APPLY");
502 case AST_ARG:
503 return("AST_ARG");
504 case AST_ROUTINE:
505 return("AST_ROUTINE");
506 case AST_STATEMENT:
507 return("AST_STATEMENT");
508 case AST_ASSIGNMENT:
509 return("AST_ASSIGNMENT");
510 case AST_CONDITIONAL:
511 return("AST_CONDITIONAL");
512 case AST_WHILE_LOOP:
513 return("AST_WHILE_LOOP");
514 case AST_RETR:
515 return("AST_RETR");
516 }
517 #endif
518 return("AST_UNKNOWN??!?");
519 }
520
521 void
522 ast_dump(struct ast *a, int indent)
523 {
524 #ifdef DEBUG
525 int i;
526
527 if (a == NULL) {
528 return;
529 }
530 for (i = 0; i < indent; i++) printf(" ");
531 if (a->label != NULL) {
532 printf("@#%d -> ", a->label - (vm_label_t)program);
533 }
534 printf(ast_name(a));
535 printf("=");
536 type_print(stdout, a->datatype);
537 switch (a->type) {
538 case AST_LOCAL:
539 printf("(%d,%d)=", a->u.local.index, a->u.local.upcount);
540 if (a->u.local.sym != NULL)
541 symbol_dump(a->u.local.sym, 0);
542 printf("\n");
543 break;
544 case AST_VALUE:
545 printf("(");
546 value_print(a->u.value.value);
547 printf(")\n");
548 break;
549 case AST_BUILTIN:
550 printf("`%s`{\n", a->u.builtin.bi->name);
551 ast_dump(a->u.builtin.right, indent + 1);
552 for (i = 0; i < indent; i++) printf(" "); printf("}\n");
553 break;
554 case AST_APPLY:
555 printf("{\n");
556 ast_dump(a->u.apply.left, indent + 1);
557 ast_dump(a->u.apply.right, indent + 1);
558 for (i = 0; i < indent; i++) printf(" "); printf("}\n");
559 break;
560 case AST_ARG:
561 printf("{\n");
562 ast_dump(a->u.arg.left, indent + 1);
563 ast_dump(a->u.arg.right, indent + 1);
564 for (i = 0; i < indent; i++) printf(" "); printf("}\n");
565 break;
566 case AST_ROUTINE:
567 printf("/%d (contains %d) {\n",
568 a->u.routine.arity, a->u.routine.cc);
569 ast_dump(a->u.routine.body, indent + 1);
570 for (i = 0; i < indent; i++) printf(" "); printf("}\n");
571 break;
572 case AST_STATEMENT:
573 printf("{\n");
574 ast_dump(a->u.statement.left, indent + 1);
575 ast_dump(a->u.statement.right, indent + 1);
576 for (i = 0; i < indent; i++) printf(" "); printf("}\n");
577 break;
578 case AST_ASSIGNMENT:
579 printf("{\n");
580 ast_dump(a->u.assignment.left, indent + 1);
581 ast_dump(a->u.assignment.right, indent + 1);
582 for (i = 0; i < indent; i++) printf(" "); printf("}\n");
583 break;
584 case AST_CONDITIONAL:
585 printf("{\n");
586 ast_dump(a->u.conditional.test, indent + 1);
587 ast_dump(a->u.conditional.yes, indent + 1);
588 if (a->u.conditional.no != NULL)
589 ast_dump(a->u.conditional.no, indent + 1);
590 for (i = 0; i < indent; i++) printf(" "); printf("}\n");
591 break;
592 case AST_WHILE_LOOP:
593 printf("{\n");
594 ast_dump(a->u.while_loop.test, indent + 1);
595 ast_dump(a->u.while_loop.body, indent + 1);
596 for (i = 0; i < indent; i++) printf(" "); printf("}\n");
597 break;
598 case AST_RETR:
599 printf("{\n");
600 ast_dump(a->u.retr.body, indent + 1);
601 for (i = 0; i < indent; i++) printf(" "); printf("}\n");
602 break;
603 }
604 #endif
605 }
+0
-128
src/ast.h less more
0 #ifndef __AST_H_
1 #define __AST_H_
2
3 #include "vm.h"
4
5 struct value;
6 struct builtin;
7 struct type;
8 struct symbol;
9 struct symbol_table;
10 struct scan_st;
11
12 struct ast_local {
13 int index;
14 int upcount;
15 struct symbol *sym;
16 };
17
18 struct ast_value {
19 struct value *value;
20 };
21
22 struct ast_builtin {
23 struct builtin *bi;
24 struct ast *right; /* ISA arg */
25 };
26
27 struct ast_apply {
28 struct ast *left; /* ISA var(/...?) (fn/cmd) */
29 struct ast *right; /* ISA arg */
30 int is_pure;
31 };
32
33 struct ast_arg {
34 struct ast *left; /* ISA arg/apply/var */
35 struct ast *right; /* ISA arg/apply/var */
36 };
37
38 struct ast_routine {
39 int arity; /* takes this many arguments */
40 int locals;/* has this many local variables */
41 int cc; /* contains this many closures */
42 struct ast *body;
43 };
44
45 struct ast_statement {
46 struct ast *left; /* ISA statement/apply */
47 struct ast *right; /* ISA statement/apply */
48 };
49
50 struct ast_assignment {
51 struct ast *left; /* ISA var */
52 struct ast *right; /* ISA apply/var */
53 };
54
55 struct ast_conditional {
56 struct ast *test; /* ISA apply/var */
57 struct ast *yes; /* ISA statement/apply */
58 struct ast *no; /* ISA statement/apply/NULL */
59 /*int index;*/ /* temp var in act rec */
60 };
61
62 struct ast_while_loop {
63 struct ast *test; /* ISA apply/var */
64 struct ast *body; /* ISA statement/apply */
65 };
66
67 struct ast_retr {
68 struct ast *body; /* ISA apply/var */
69 };
70
71 #define AST_LOCAL 1
72 #define AST_VALUE 2
73 #define AST_BUILTIN 3
74 #define AST_APPLY 4
75 #define AST_ARG 5
76 #define AST_ROUTINE 6
77 #define AST_STATEMENT 7
78 #define AST_ASSIGNMENT 8
79 #define AST_CONDITIONAL 9
80 #define AST_WHILE_LOOP 10
81 #define AST_RETR 11
82
83 union ast_union {
84 struct ast_local local;
85 struct ast_value value;
86 struct ast_builtin builtin;
87 struct ast_apply apply;
88 struct ast_arg arg;
89 struct ast_routine routine;
90 struct ast_statement statement;
91 struct ast_assignment assignment;
92 struct ast_conditional conditional;
93 struct ast_while_loop while_loop;
94 struct ast_retr retr;
95 };
96
97 struct ast {
98 int type;
99 struct scan_st *sc;
100 struct type *datatype;
101 vm_label_t label;
102 union ast_union u;
103 };
104
105 struct ast *ast_new_local(struct symbol_table *, struct symbol *);
106 struct ast *ast_new_value(struct value *, struct type *);
107 struct ast *ast_new_builtin(struct scan_st *, struct builtin *, struct ast *);
108 struct ast *ast_new_apply(struct scan_st *, struct ast *, struct ast *, int);
109 struct ast *ast_new_arg(struct ast *, struct ast *);
110 struct ast *ast_new_routine(int, int, int, struct ast *);
111 struct ast *ast_new_statement(struct ast *, struct ast *);
112 struct ast *ast_new_assignment(struct scan_st *, struct ast *, struct ast *);
113 struct ast *ast_new_conditional(struct scan_st *, struct ast *, struct ast *, struct ast *);
114 struct ast *ast_new_while_loop(struct scan_st *, struct ast *, struct ast *);
115 struct ast *ast_new_retr(struct ast *);
116 void ast_free(struct ast *);
117
118 int ast_is_constant(struct ast *);
119 int ast_count_args(struct ast *);
120
121 void ast_dump(struct ast *, int);
122 char *ast_name(struct ast *);
123
124 void ast_eval_init(void);
125 void ast_eval(struct ast *, struct value **);
126
127 #endif /* !__AST_H_ */
+0
-28
src/atom.c less more
0 #include <string.h>
1 #include <stdlib.h>
2
3 #include "mem.h"
4 #include "atom.h"
5
6 static struct atom_entry *atom_entry_head = NULL;
7 static int next_atom = 0;
8
9 int
10 atom_resolve(char *lexeme)
11 {
12 struct atom_entry *ae;
13
14 /* find lexeme in atom table */
15 for (ae = atom_entry_head; ae != NULL; ae = ae->next) {
16 if (strcmp(ae->lexeme, lexeme) == 0)
17 return(ae->atom);
18 }
19 /* create new atom */
20 ae = bhuna_malloc(sizeof(struct atom_entry));
21 ae->next = atom_entry_head;
22 ae->lexeme = strdup(lexeme);
23 ae->atom = next_atom++;
24 atom_entry_head = ae;
25
26 return(ae->atom);
27 }
+0
-12
src/atom.h less more
0 #ifndef __ATOM_H_
1 #define __ATOM_H_
2
3 struct atom_entry {
4 struct atom_entry *next;
5 char *lexeme;
6 int atom;
7 };
8
9 int atom_resolve(char *);
10
11 #endif /* !__ATOM_H_ */
+0
-347
src/buffer.c less more
0 /*
1 * Copyright (c) 2004 The DragonFly Project. All rights reserved.
2 *
3 * This code is derived from software contributed to The DragonFly Project
4 * by Chris Pressey <cpressey@catseye.mine.nu>.
5 *
6 * Redistribution and use in source and binary forms, with or without
7 * modification, are permitted provided that the following conditions
8 * are met:
9 *
10 * 1. Redistributions of source code must retain the above copyright
11 * notice, this list of conditions and the following disclaimer.
12 * 2. Redistributions in binary form must reproduce the above copyright
13 * notice, this list of conditions and the following disclaimer in
14 * the documentation and/or other materials provided with the
15 * distribution.
16 * 3. Neither the name of The DragonFly Project nor the names of its
17 * contributors may be used to endorse or promote products derived
18 * from this software without specific, prior written permission.
19 *
20 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21 * ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
23 * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
24 * COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
25 * INCIDENTAL, SPECIAL, EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING,
26 * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
27 * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
28 * AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
29 * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
30 * OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
31 * SUCH DAMAGE.
32 */
33
34 /*
35 * extbuf.c
36 * $Id: buffer.c,v 1.1 2004/07/21 19:52:35 cpressey Exp $
37 * Routines to manipulate extensible buffers.
38 *
39 * Aura buffers are buffers that attempt to automatically expand
40 * when more data is written to them than they can initially hold.
41 * In addition, each extensible buffer contains a cursor from which
42 * its contents may be incrementally scanned.
43 */
44
45 #include <err.h>
46 #include <stdarg.h>
47 #include <stdio.h>
48 #include <stdlib.h>
49 #include <string.h>
50 #include <sysexits.h>
51
52 #include "buffer.h"
53
54 /*
55 * Create a new extensible buffer with the given initial size.
56 */
57 struct aura_buffer *
58 aura_buffer_new(size_t size)
59 {
60 struct aura_buffer *e;
61
62 e = malloc(sizeof(struct aura_buffer));
63
64 e->len = 0;
65 e->size = size;
66 e->pos = 0;
67
68 e->buf = malloc(size);
69 e->buf[0] = '\0';
70
71 return(e);
72 }
73
74 /*
75 * Deallocate the memory used for an extensible buffer.
76 */
77 void
78 aura_buffer_free(struct aura_buffer *e)
79 {
80 if (e != NULL) {
81 if (e->buf != NULL)
82 free(e->buf);
83 free(e);
84 }
85 }
86
87 /*
88 * Return the underlying (static) buffer of an extensible buffer.
89 *
90 * NOTE that you should NEVER cache the returned pointer anywhere,
91 * as any further manipulation of the extensible buffer may cause
92 * it to be invalidated.
93 *
94 * ALSO NOTE that the buffer may contain embedded NULs, but will
95 * also be guaranteed to be NUL-terminated.
96 */
97 char *
98 aura_buffer_buf(struct aura_buffer *e)
99 {
100 return(e->buf);
101 }
102
103 /*
104 * Return the current length of the extensible buffer.
105 */
106 size_t
107 aura_buffer_len(struct aura_buffer *e)
108 {
109 return(e->len);
110 }
111
112 /*
113 * Return the current size of the extensible buffer. This is how
114 * big it's length may grow to before expanded.
115 */
116 size_t
117 aura_buffer_size(struct aura_buffer *e)
118 {
119 return(e->size);
120 }
121
122 /*
123 * Ensure that an extensible buffer's size is at least the given
124 * size. If it is not, it will be internally grown to that size.
125 * This does not affect the contents of the buffer in any way.
126 */
127 void
128 aura_buffer_ensure_size(struct aura_buffer *e, size_t size)
129 {
130 if (e->size >= size) return;
131 e->size = size;
132 if ((e->buf = realloc(e->buf, e->size)) == NULL) {
133 err(EX_UNAVAILABLE, "realloc()");
134 }
135 }
136
137 /*
138 * Set the contents of an extensible buffer from a regular (char *)
139 * buffer. The extensible buffer will grow if needed. Any existing
140 * contents of the extensible buffer are destroyed in this operation.
141 * Note that, because this requires that the length of the
142 * regular buffer be specified, it may safely contain NUL bytes.
143 */
144 void
145 aura_buffer_set(struct aura_buffer *e, char *buf, size_t length)
146 {
147 while ((length + 1) > e->size) {
148 e->size *= 2;
149 }
150 if ((e->buf = realloc(e->buf, e->size)) == NULL) {
151 err(EX_UNAVAILABLE, "realloc()");
152 }
153 memcpy(e->buf, buf, length);
154 e->len = length;
155 e->buf[e->len] = '\0';
156 }
157
158 /*
159 * Append the contents of a regular buffer to the end of the existing
160 * contents of an extensible buffer. The extensible buffer will grow
161 * if needed. Note that, because this requires that the length of the
162 * regular buffer be specified, it may safely contain NUL bytes.
163 */
164 void
165 aura_buffer_append(struct aura_buffer *e, char *buf, size_t length)
166 {
167 while (e->len + (length + 1) > e->size) {
168 e->size *= 2;
169 }
170 if ((e->buf = realloc(e->buf, e->size)) == NULL) {
171 err(EX_UNAVAILABLE, "realloc()");
172 }
173 memcpy(e->buf + e->len, buf, length);
174 e->len += length;
175 e->buf[e->len] = '\0';
176 }
177
178 /*
179 * Set the contents of an extensible buffer from an ASCIIZ string.
180 * This is identical to aura_buffer_set except that the length need not
181 * be specified, and the ASCIIZ string may not contain embedded NUL's.
182 */
183 void
184 aura_buffer_cpy(struct aura_buffer *e, char *s)
185 {
186 aura_buffer_set(e, s, strlen(s));
187 }
188
189 /*
190 * Append the contents of an ASCIIZ string to an extensible buffer.
191 * This is identical to aura_buffer_append except that the length need not
192 * be specified, and the ASCIIZ string may not contain embedded NUL's.
193 */
194 void
195 aura_buffer_cat(struct aura_buffer *e, char *s)
196 {
197 aura_buffer_append(e, s, strlen(s));
198 }
199
200 /*
201 * Append the entire contents of a text file to an extensible buffer.
202 */
203 int
204 aura_buffer_cat_file(struct aura_buffer *e, char *fmt, ...)
205 {
206 va_list args;
207 char *filename, line[1024];
208 FILE *f;
209
210 va_start(args, fmt);
211 vasprintf(&filename, fmt, args);
212 va_end(args);
213
214 if ((f = fopen(filename, "r")) == NULL)
215 return(0);
216
217 free(filename);
218
219 while (fgets(line, 1023, f) != NULL) {
220 aura_buffer_cat(e, line);
221 }
222
223 fclose(f);
224
225 return(1);
226 }
227
228 /*
229 * Append the entire output of a shell command to an extensible buffer.
230 */
231 int
232 aura_buffer_cat_pipe(struct aura_buffer *e, char *fmt, ...)
233 {
234 va_list args;
235 char *command, line[1024];
236 FILE *p;
237
238 va_start(args, fmt);
239 vasprintf(&command, fmt, args);
240 va_end(args);
241
242 if ((p = popen(command, "r")) == NULL)
243 return(0);
244
245 free(command);
246
247 while (fgets(line, 1023, p) != NULL) {
248 aura_buffer_cat(e, line);
249 }
250
251 pclose(p);
252
253 return(1);
254 }
255
256 /*** CURSORED FUNCTIONS ***/
257
258 /*
259 * Note that the cursor can be anywhere from the first character to
260 * one position _beyond_ the last character in the buffer.
261 */
262
263 int
264 aura_buffer_seek(struct aura_buffer *e, size_t pos)
265 {
266 if (pos <= e->size) {
267 e->pos = pos;
268 return(1);
269 } else {
270 return(0);
271 }
272 }
273
274 size_t
275 aura_buffer_tell(struct aura_buffer *e)
276 {
277 return(e->pos);
278 }
279
280 int
281 aura_buffer_eof(struct aura_buffer *e)
282 {
283 return(e->pos >= e->size);
284 }
285
286 char
287 aura_buffer_peek_char(struct aura_buffer *e)
288 {
289 return(e->buf[e->pos]);
290 }
291
292 char
293 aura_buffer_scan_char(struct aura_buffer *e)
294 {
295 return(e->buf[e->pos++]);
296 }
297
298 int
299 aura_buffer_compare(struct aura_buffer *e, char *s)
300 {
301 int i, pos;
302
303 for (i = 0, pos = e->pos; s[i] != '\0' && pos < e->size; i++, pos++) {
304 if (e->buf[pos] != s[i])
305 return(0);
306 }
307
308 if (pos <= e->size) {
309 return(pos);
310 } else {
311 return(0);
312 }
313 }
314
315 int
316 aura_buffer_expect(struct aura_buffer *e, char *s)
317 {
318 int pos;
319
320 if ((pos = aura_buffer_compare(e, s)) > 0) {
321 e->pos = pos;
322 return(1);
323 } else {
324 return(0);
325 }
326 }
327
328 void
329 aura_buffer_push(struct aura_buffer *e, void *src, size_t len)
330 {
331 aura_buffer_ensure_size(e, e->pos + len);
332 memcpy(e->buf + e->pos, src, len);
333 e->pos += len;
334 }
335
336 int
337 aura_buffer_pop(struct aura_buffer *e, void *dest, size_t len)
338 {
339 if (e->pos - len > 0) {
340 e->pos -= len;
341 memcpy(dest, e->buf + e->pos, len);
342 return(1);
343 } else {
344 return(0);
345 }
346 }
+0
-78
src/buffer.h less more
0 /*
1 * Copyright (c) 2004 The DragonFly Project. All rights reserved.
2 *
3 * This code is derived from software contributed to The DragonFly Project
4 * by Chris Pressey <cpressey@catseye.mine.nu>.
5 *
6 * Redistribution and use in source and binary forms, with or without
7 * modification, are permitted provided that the following conditions
8 * are met:
9 *
10 * 1. Redistributions of source code must retain the above copyright
11 * notice, this list of conditions and the following disclaimer.
12 * 2. Redistributions in binary form must reproduce the above copyright
13 * notice, this list of conditions and the following disclaimer in
14 * the documentation and/or other materials provided with the
15 * distribution.
16 * 3. Neither the name of The DragonFly Project nor the names of its
17 * contributors may be used to endorse or promote products derived
18 * from this software without specific, prior written permission.
19 *
20 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21 * ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
23 * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
24 * COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
25 * INCIDENTAL, SPECIAL, EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING,
26 * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
27 * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
28 * AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
29 * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
30 * OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
31 * SUCH DAMAGE.
32 */
33
34 /*
35 * buffer.h
36 * $Id: buffer.h,v 1.1 2004/07/21 19:52:35 cpressey Exp $
37 */
38
39 #ifndef __AURA_BUFFER_H_
40 #define __AURA_BUFFER_H_
41
42 #include <stdlib.h>
43
44 struct aura_buffer {
45 char *buf;
46 size_t len;
47 size_t size;
48 size_t pos;
49 };
50
51 struct aura_buffer *aura_buffer_new(size_t);
52 void aura_buffer_free(struct aura_buffer *);
53 char *aura_buffer_buf(struct aura_buffer *);
54 size_t aura_buffer_len(struct aura_buffer *);
55 size_t aura_buffer_size(struct aura_buffer *);
56
57 void aura_buffer_ensure_size(struct aura_buffer *, size_t);
58 void aura_buffer_set(struct aura_buffer *, char *, size_t);
59 void aura_buffer_append(struct aura_buffer *, char *, size_t);
60
61 void aura_buffer_cpy(struct aura_buffer *, char *);
62 void aura_buffer_cat(struct aura_buffer *, char *);
63 int aura_buffer_cat_file(struct aura_buffer *, char *, ...);
64 int aura_buffer_cat_pipe(struct aura_buffer *, char *, ...);
65
66 int aura_buffer_seek(struct aura_buffer *, size_t);
67 size_t aura_buffer_tell(struct aura_buffer *);
68 int aura_buffer_eof(struct aura_buffer *);
69 char aura_buffer_peek_char(struct aura_buffer *);
70 char aura_buffer_scan_char(struct aura_buffer *);
71 int aura_buffer_compare(struct aura_buffer *, char *);
72 int aura_buffer_expect(struct aura_buffer *, char *);
73
74 void aura_buffer_push(struct aura_buffer *, void *, size_t);
75 int aura_buffer_pop(struct aura_buffer *, void *, size_t);
76
77 #endif /* !__AURA_BUFFER_H_ */
+0
-491
src/builtin.c less more
0 #include <stdio.h>
1 #include <stdlib.h>
2
3 #include "builtin.h"
4 #include "value.h"
5 #include "list.h"
6 #include "dict.h"
7 #include "closure.h"
8 #include "activation.h"
9 #include "type.h"
10
11 /*
12 * Built-in operations.
13 */
14
15 struct builtin builtins[] = {
16 {"Print", builtin_print, btype_print, -1, 0, 1, 0},
17 {"!", builtin_not, btype_unary_logic, 1, 1, 1, 1},
18 {"&", builtin_and, btype_binary_logic, 2, 1, 1, 2},
19 {"|", builtin_or, btype_binary_logic, 2, 1, 1, 3},
20 {"=", builtin_equ, btype_compare, 2, 1, 1, 4},
21 {"!=", builtin_neq, btype_compare, 2, 1, 1, 5},
22 {">", builtin_gt, btype_compare, 2, 1, 1, 6},
23 {"<", builtin_lt, btype_compare, 2, 1, 1, 7},
24 {">=", builtin_gte, btype_compare, 2, 1, 1, 8},
25 {"<=", builtin_lte, btype_compare, 2, 1, 1, 9},
26 {"+", builtin_add, btype_arith, 2, 1, 1, 10},
27 {"-", builtin_sub, btype_arith, 2, 1, 1, 11},
28 {"*", builtin_mul, btype_arith, 2, 1, 1, 12},
29 {"/", builtin_div, btype_arith, 2, 1, 1, 13},
30 {"%", builtin_mod, btype_arith, 2, 1, 1, 14},
31 {"List", builtin_list, btype_list, -1, 1, 1, 15},
32 {"Fetch", builtin_fetch, btype_fetch, 2, 1, 1, 16},
33 {"Store", builtin_store, btype_store, 3, 0, 1, 17},
34 {"Dict", builtin_dict, btype_dict, -1, 1, 1, 18},
35 {NULL, NULL, NULL, 0, 0, 0, 19}
36 };
37
38 void
39 builtin_print(struct activation *ar, struct value **q)
40 {
41 int i;
42 /*struct list *l;*/
43 struct value *v = NULL;
44
45 for (i = 0; i < ar->size; i++) {
46 v = activation_get_value(ar, i, 0);
47 if (v == NULL) {
48 printf("(null)");
49 continue;
50 }
51
52 switch (v->type) {
53 case VALUE_INTEGER:
54 printf("%d", v->v.i);
55 break;
56 case VALUE_BOOLEAN:
57 printf("%s", v->v.b ? "true" : "false");
58 break;
59 case VALUE_STRING:
60 printf("%s", v->v.s);
61 break;
62 case VALUE_LIST:
63 /*
64 printf("[");
65 for (l = v->v.l; l != NULL; l = l->next) {
66 */
67
68 list_dump(v->v.l);
69 break;
70 case VALUE_ERROR:
71 printf("#ERR<%s>", v->v.e);
72 break;
73 case VALUE_BUILTIN:
74 printf("#BIF<%08lx>", (unsigned long)v->v.bi);
75 break;
76 case VALUE_CLOSURE:
77 closure_dump(v->v.k);
78 break;
79 case VALUE_DICT:
80 dict_dump(v->v.d);
81 break;
82 default:
83 printf("???unknown(%d)???", v->type);
84 break;
85 }
86 }
87
88 value_set_from_value(q, v);
89 }
90
91 /*** logical ***/
92
93 void
94 builtin_not(struct activation *ar, struct value **v)
95 {
96 struct value *q = activation_get_value(ar, 0, 0);
97
98 if (q->type == VALUE_BOOLEAN) {
99 return(value_set_boolean(v, !q->v.b));
100 } else {
101 return(value_set_error(v, "type mismatch"));
102 }
103 }
104
105 void
106 builtin_and(struct activation *ar, struct value **v)
107 {
108 struct value *l = activation_get_value(ar, 0, 0);
109 struct value *r = activation_get_value(ar, 1, 0);
110
111 if (l->type == VALUE_BOOLEAN && r->type == VALUE_BOOLEAN) {
112 return(value_set_boolean(v, l->v.b && r->v.b));
113 } else {
114 return(value_set_error(v, "type mismatch"));
115 }
116 }
117
118 void
119 builtin_or(struct activation *ar, struct value **v)
120 {
121 struct value *l = activation_get_value(ar, 0, 0);
122 struct value *r = activation_get_value(ar, 1, 0);
123
124 if (l->type == VALUE_BOOLEAN && r->type == VALUE_BOOLEAN) {
125 return(value_set_boolean(v, l->v.b || r->v.b));
126 } else {
127 return(value_set_error(v, "type mismatch"));
128 }
129 }
130
131 /*** comparison ***/
132
133 void
134 builtin_equ(struct activation *ar, struct value **v)
135 {
136 struct value *l = activation_get_value(ar, 0, 0);
137 struct value *r = activation_get_value(ar, 1, 0);
138
139 if (l->type == VALUE_INTEGER && r->type == VALUE_INTEGER) {
140 return(value_set_boolean(v, l->v.i == r->v.i));
141 } else {
142 return(value_set_error(v, "type mismatch"));
143 }
144 }
145
146 void
147 builtin_neq(struct activation *ar, struct value **v)
148 {
149 struct value *l = activation_get_value(ar, 0, 0);
150 struct value *r = activation_get_value(ar, 1, 0);
151
152 if (l->type == VALUE_INTEGER && r->type == VALUE_INTEGER) {
153 return(value_set_boolean(v, l->v.i != r->v.i));
154 } else {
155 return(value_set_error(v, "type mismatch"));
156 }
157 }
158
159 void
160 builtin_gt(struct activation *ar, struct value **v)
161 {
162 struct value *l = activation_get_value(ar, 0, 0);
163 struct value *r = activation_get_value(ar, 1, 0);
164
165 if (l->type == VALUE_INTEGER && r->type == VALUE_INTEGER) {
166 return(value_set_boolean(v, l->v.i > r->v.i));
167 } else {
168 return(value_set_error(v, "type mismatch"));
169 }
170 }
171
172 void
173 builtin_lt(struct activation *ar, struct value **v)
174 {
175 struct value *l = activation_get_value(ar, 0, 0);
176 struct value *r = activation_get_value(ar, 1, 0);
177
178 if (l->type == VALUE_INTEGER && r->type == VALUE_INTEGER) {
179 return(value_set_boolean(v, l->v.i < r->v.i));
180 } else {
181 return(value_set_error(v, "type mismatch"));
182 }
183 }
184
185 void
186 builtin_gte(struct activation *ar, struct value **v)
187 {
188 struct value *l = activation_get_value(ar, 0, 0);
189 struct value *r = activation_get_value(ar, 1, 0);
190
191 if (l->type == VALUE_INTEGER && r->type == VALUE_INTEGER) {
192 return(value_set_boolean(v, l->v.i >= r->v.i));
193 } else {
194 return(value_set_error(v, "type mismatch"));
195 }
196 }
197
198 void
199 builtin_lte(struct activation *ar, struct value **v)
200 {
201 struct value *l = activation_get_value(ar, 0, 0);
202 struct value *r = activation_get_value(ar, 1, 0);
203
204 if (l->type == VALUE_INTEGER && r->type == VALUE_INTEGER) {
205 return(value_set_boolean(v, l->v.i <= r->v.i));
206 } else {
207 return(value_set_error(v, "type mismatch"));
208 }
209 }
210
211 /*** arithmetic ***/
212
213 void
214 builtin_add(struct activation *ar, struct value **v)
215 {
216 struct value *l = activation_get_value(ar, 0, 0);
217 struct value *r = activation_get_value(ar, 1, 0);
218
219 if (l->type == VALUE_INTEGER && r->type == VALUE_INTEGER) {
220 return(value_set_integer(v, l->v.i + r->v.i));
221 } else {
222 return(value_set_error(v, "type mismatch"));
223 }
224 }
225
226 void
227 builtin_mul(struct activation *ar, struct value **v)
228 {
229 struct value *l = activation_get_value(ar, 0, 0);
230 struct value *r = activation_get_value(ar, 1, 0);
231
232 #if 0
233 printf("IN MUL, L = ");
234 value_print(l);
235 printf(" R = ");
236 value_print(r);
237 printf("\n");
238 #endif
239
240 if (l->type == VALUE_INTEGER && r->type == VALUE_INTEGER) {
241 return(value_set_integer(v, l->v.i * r->v.i));
242 } else {
243 return(value_set_error(v, "type mismatch"));
244 }
245 }
246
247 void
248 builtin_sub(struct activation *ar, struct value **v)
249 {
250 struct value *l = activation_get_value(ar, 0, 0);
251 struct value *r = activation_get_value(ar, 1, 0);
252
253 if (l->type == VALUE_INTEGER && r->type == VALUE_INTEGER) {
254 return(value_set_integer(v, l->v.i - r->v.i));
255 } else {
256 return(value_set_error(v, "type mismatch"));
257 }
258 }
259
260 void
261 builtin_div(struct activation *ar, struct value **v)
262 {
263 struct value *l = activation_get_value(ar, 0, 0);
264 struct value *r = activation_get_value(ar, 1, 0);
265
266 if (l->type == VALUE_INTEGER && r->type == VALUE_INTEGER) {
267 if (r->v.i == 0)
268 return(value_set_error(v, "division by zero"));
269 else
270 return(value_set_integer(v, l->v.i / r->v.i));
271 } else {
272 return(value_set_error(v, "type mismatch"));
273 }
274 }
275
276 void
277 builtin_mod(struct activation *ar, struct value **v)
278 {
279 struct value *l = activation_get_value(ar, 0, 0);
280 struct value *r = activation_get_value(ar, 1, 0);
281
282 if (l->type == VALUE_INTEGER && r->type == VALUE_INTEGER) {
283 if (r->v.i == 0)
284 return(value_set_error(v, "modulo by zero"));
285 else
286 return(value_set_integer(v, l->v.i % r->v.i));
287 } else {
288 return(value_set_error(v, "type mismatch"));
289 }
290 }
291
292 /*** list ***/
293
294 void
295 builtin_list(struct activation *ar, struct value **v)
296 {
297 int i;
298 struct value *x = NULL;
299
300 value_set_list(v);
301
302 for (i = ar->size - 1; i >= 0; i--) {
303 x = activation_get_value(ar, i, 0);
304 value_list_append(v, x);
305 value_release(x);
306 }
307 }
308
309 void
310 builtin_fetch(struct activation *ar, struct value **v)
311 {
312 struct value *l = activation_get_value(ar, 0, 0);
313 struct value *r = activation_get_value(ar, 1, 0);
314 struct value *q;
315 int count;
316 struct list *li;
317
318 if (l->type == VALUE_CLOSURE && r->type == VALUE_INTEGER) {
319 int i = r->v.i - 1;
320 /*
321 * This is _EVIL_!
322 */
323 if (i >= 0 && i < l->v.k->ar->size) {
324 q = activation_get_value(l->v.k->ar, i, 0);
325 value_set_from_value(v, q);
326 } else {
327 value_set_error(v, "out of bounds");
328 }
329 } else if (l->type == VALUE_DICT) {
330 q = dict_fetch(l->v.d, r);
331 value_set_from_value(v, q);
332 value_release(q);
333 } else if (l->type == VALUE_LIST && r->type == VALUE_INTEGER) {
334 li = l->v.l;
335 for (count = 1; li != NULL && count < r->v.i; count++)
336 li = li->next;
337 if (li == NULL)
338 return(value_set_error(v, "out of bounds"));
339 else {
340 value_set_from_value(v, li->value);
341 }
342 } else {
343 return(value_set_error(v, "type mismatch"));
344 }
345 }
346
347 void
348 builtin_store(struct activation *ar, struct value **v)
349 {
350 struct value *d = activation_get_value(ar, 0, 0);
351 struct value *i = activation_get_value(ar, 1, 0);
352 struct value *p = activation_get_value(ar, 2, 0);
353 int count;
354 struct list *li;
355
356 if (d->type == VALUE_DICT) {
357 dict_store(d->v.d, i, p);
358 value_set_from_value(v, d);
359 } else if (d->type == VALUE_LIST && i->type == VALUE_INTEGER) {
360 li = d->v.l;
361 for (count = 1; li != NULL && count < i->v.i; count++)
362 li = li->next;
363 if (li == NULL)
364 value_set_error(v, "no such element");
365 else {
366 value_set_from_value(&li->value, p);
367 value_set_from_value(v, d);
368 }
369 } else {
370 value_set_error(v, "type mismatch");
371 }
372 }
373
374 void
375 builtin_dict(struct activation *ar, struct value **v)
376 {
377 int i;
378 struct value *key = NULL, *val = NULL;
379
380 value_set_dict(v);
381
382 if (ar->size % 2 != 0) {
383 value_set_error(v, "number of argument must be even");
384 } else {
385 for (i = 0; i < ar->size; i += 2) {
386 key = activation_get_value(ar, i, 0);
387 val = activation_get_value(ar, i + 1, 0);
388 value_dict_store(v, key, val);
389 value_release(key);
390 value_release(val);
391 }
392 }
393 }
394
395 struct type *
396 btype_print(void)
397 {
398 return(
399 type_new_closure(
400 type_new_var(1),
401 type_new(TYPE_VOID)
402 )
403 );
404 }
405
406 struct type *
407 btype_unary_logic(void)
408 {
409 return(
410 type_new_closure(
411 type_new(TYPE_BOOLEAN),
412 type_new(TYPE_BOOLEAN)
413 )
414 );
415 }
416
417 struct type *
418 btype_binary_logic(void)
419 {
420 return(
421 type_new_closure(
422 type_new_arg(type_new(TYPE_BOOLEAN), type_new(TYPE_BOOLEAN)),
423 type_new(TYPE_BOOLEAN)
424 )
425 );
426 }
427
428 struct type *
429 btype_compare(void)
430 {
431 return(
432 type_new_closure(
433 type_new_arg(type_new(TYPE_INTEGER), type_new(TYPE_INTEGER)),
434 type_new(TYPE_BOOLEAN)
435 )
436 );
437 }
438
439 struct type *
440 btype_arith(void)
441 {
442 return(
443 type_new_closure(
444 type_new_arg(type_new(TYPE_INTEGER), type_new(TYPE_INTEGER)),
445 type_new(TYPE_INTEGER)
446 )
447 );
448 }
449
450 struct type *
451 btype_list(void)
452 {
453 return(
454 type_new_closure(
455 type_new_var(2),
456 type_new_list(type_new(TYPE_INTEGER))
457 )
458 );
459 }
460
461 struct type *
462 btype_fetch(void)
463 {
464 return(
465 type_new_closure(
466 type_new_arg(type_new_var(5), type_new(TYPE_INTEGER)),
467 type_new_var(5)
468 )
469 );
470 }
471
472 struct type *
473 btype_store(void)
474 {
475 return(
476 type_new_closure(
477 type_new_arg(
478 type_new_var(6),
479 type_new_arg(type_new_var(7), type_new_var(8))
480 ),
481 type_new(TYPE_VOID)
482 )
483 );
484 }
485
486 struct type *
487 btype_dict(void)
488 {
489 return(NULL);
490 }
+0
-77
src/builtin.h less more
0 #ifndef __BUILTIN_H_
1 #define __BUILTIN_H_
2
3 struct value;
4 struct activation;
5 struct type;
6
7 struct builtin {
8 char *name;
9 void (*fn)(struct activation *, struct value **);
10 struct type *(*ty)(void);
11 int arity;
12 int is_pure;
13 int is_const;
14 int index;
15 };
16
17 #define INDEX_BUILTIN_PRINT 0
18 #define INDEX_BUILTIN_NOT 1
19 #define INDEX_BUILTIN_AND 2
20 #define INDEX_BUILTIN_OR 3
21 #define INDEX_BUILTIN_EQU 4
22 #define INDEX_BUILTIN_NEQ 5
23 #define INDEX_BUILTIN_GT 6
24 #define INDEX_BUILTIN_LT 7
25 #define INDEX_BUILTIN_GTE 8
26 #define INDEX_BUILTIN_LTE 9
27 #define INDEX_BUILTIN_ADD 10
28 #define INDEX_BUILTIN_SUB 11
29 #define INDEX_BUILTIN_MUL 12
30 #define INDEX_BUILTIN_DIV 13
31 #define INDEX_BUILTIN_MOD 14
32 #define INDEX_BUILTIN_LIST 15
33 #define INDEX_BUILTIN_FETCH 16
34 #define INDEX_BUILTIN_STORE 17
35 #define INDEX_BUILTIN_DICT 18
36
37 #define INDEX_BUILTIN_LAST 127
38
39 extern struct builtin builtins[];
40
41 void builtin_print(struct activation *, struct value **);
42
43 void builtin_not(struct activation *, struct value **);
44 void builtin_and(struct activation *, struct value **);
45 void builtin_or(struct activation *, struct value **);
46
47 void builtin_equ(struct activation *, struct value **);
48 void builtin_neq(struct activation *, struct value **);
49 void builtin_gt(struct activation *, struct value **);
50 void builtin_lt(struct activation *, struct value **);
51 void builtin_gte(struct activation *, struct value **);
52 void builtin_lte(struct activation *, struct value **);
53
54 void builtin_add(struct activation *, struct value **);
55 void builtin_mul(struct activation *, struct value **);
56 void builtin_sub(struct activation *, struct value **);
57 void builtin_div(struct activation *, struct value **);
58 void builtin_mod(struct activation *, struct value **);
59
60 void builtin_list(struct activation *, struct value **);
61 void builtin_fetch(struct activation *, struct value **);
62 void builtin_store(struct activation *, struct value **);
63
64 void builtin_dict(struct activation *, struct value **);
65
66 struct type *btype_print(void);
67 struct type *btype_unary_logic(void);
68 struct type *btype_binary_logic(void);
69 struct type *btype_compare(void);
70 struct type *btype_arith(void);
71 struct type *btype_list(void);
72 struct type *btype_fetch(void);
73 struct type *btype_store(void);
74 struct type *btype_dict(void);
75
76 #endif
+0
-42
src/closure.c less more
0 #include <assert.h>
1 #include <stdio.h>
2 #include <stdlib.h>
3
4 #include "mem.h"
5 #include "closure.h"
6 #include "symbol.h"
7 #include "ast.h"
8 #include "activation.h"
9 #include "vm.h"
10
11 #include "type.h"
12
13 struct closure *
14 closure_new(struct ast *a, struct activation *ar)
15 {
16 struct closure *c;
17
18 c = bhuna_malloc(sizeof(struct closure));
19
20 c->ast = a;
21 c->ar = ar;
22
23 return(c);
24 }
25
26 void
27 closure_free(struct closure *c)
28 {
29 bhuna_free(c);
30 }
31
32 void
33 closure_dump(struct closure *c)
34 {
35 #ifdef DEBUG
36 printf("closure{");
37 activation_dump(c->ar, 1);
38 ast_dump(c->ast, 1);
39 printf("}");
40 #endif
41 }
+0
-18
src/closure.h less more
0 #ifndef __CLOSURE_H_
1 #define __CLOSURE_H_
2
3 #include "vm.h"
4
5 struct activation;
6 struct ast;
7
8 struct closure {
9 struct ast *ast;
10 struct activation *ar; /* env in which we were created */
11 };
12
13 struct closure *closure_new(struct ast *, struct activation *);
14 void closure_free(struct closure *);
15 void closure_dump(struct closure *);
16
17 #endif
+0
-338
src/dict.c less more
0 /*
1 * Copyright (c) 2004 The DragonFly Project. All rights reserved.
2 *
3 * This code is derived from software contributed to The DragonFly Project
4 * by Chris Pressey <cpressey@catseye.mine.nu>.
5 *
6 * Redistribution and use in source and binary forms, with or without
7 * modification, are permitted provided that the following conditions
8 * are met:
9 *
10 * 1. Redistributions of source code must retain the above copyright
11 * notice, this list of conditions and the following disclaimer.
12 * 2. Redistributions in binary form must reproduce the above copyright
13 * notice, this list of conditions and the following disclaimer in
14 * the documentation and/or other materials provided with the
15 * distribution.
16 * 3. Neither the name of The DragonFly Project nor the names of its
17 * contributors may be used to endorse or promote products derived
18 * from this software without specific, prior written permission.
19 *
20 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21 * ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
23 * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
24 * COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
25 * INCIDENTAL, SPECIAL, EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING,
26 * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
27 * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
28 * AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
29 * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
30 * OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
31 * SUCH DAMAGE.
32 */
33
34 /*
35 * dict.c
36 * $Id$
37 * Routines to manipulate Bhuna dictionaries.
38 */
39
40 #include <assert.h>
41 #include <stdlib.h>
42 #include <string.h>
43 #include <stdio.h>
44
45 #include "mem.h"
46
47 #include "dict.h"
48 #include "value.h"
49
50 /*** CONSTRUCTOR ***/
51
52 /*
53 * Create a new dictionary.
54 */
55 struct dict *
56 dict_new(void)
57 {
58 struct dict *d;
59 int i;
60
61 d = bhuna_malloc(sizeof(struct dict));
62 d->num_buckets = 31;
63 d->bucket = bhuna_malloc(sizeof(struct chain *) * d->num_buckets);
64 for (i = 0; i < d->num_buckets; i++) {
65 d->bucket[i] = NULL;
66 }
67 d->cursor = NULL;
68 d->cur_bucket = 0;
69
70 return(d);
71 }
72
73 static struct chain *
74 chain_dup(struct chain *f)
75 {
76 struct chain *c, *n, *p = NULL, *h = NULL;
77
78 for (c = f; c != NULL; c = c->next) {
79 n = bhuna_malloc(sizeof(struct chain));
80
81 n->next = NULL;
82 value_grab(c->key);
83 n->key = c->key;
84 value_grab(c->value);
85 n->value = c->value;
86
87 if (h == NULL)
88 h = n;
89 else
90 p->next = n;
91
92 p = n;
93 }
94
95 return(h);
96 }
97
98 struct dict *
99 dict_dup(struct dict *f)
100 {
101 struct dict *d;
102 int i;
103
104 d = bhuna_malloc(sizeof(struct dict));
105 d->num_buckets = 31;
106 d->bucket = bhuna_malloc(sizeof(struct chain *) * d->num_buckets);
107 for (i = 0; i < d->num_buckets; i++) {
108 d->bucket[i] = chain_dup(f->bucket[i]);
109 }
110 d->cursor = NULL; /* hmmm... dup'ing this would take trickery. */
111 d->cur_bucket = 0;
112
113 return(d);
114 }
115
116 /*** DESTRUCTORS ***/
117
118 static void
119 chain_free(struct chain *c)
120 {
121 assert(c != NULL);
122
123 value_release(c->key);
124 value_release(c->value);
125
126 bhuna_free(c);
127 }
128
129 void
130 dict_free(struct dict *d)
131 {
132 struct chain *c;
133 size_t bucket_no;
134
135 for (bucket_no = 0; bucket_no < d->num_buckets; bucket_no++) {
136 c = d->bucket[bucket_no];
137 while (c != NULL) {
138 d->bucket[bucket_no] = c->next;
139 chain_free(c);
140 c = d->bucket[bucket_no];
141 }
142 }
143 bhuna_free(d);
144 }
145
146 /*** UTILITIES ***/
147
148 /*
149 * Hash function, taken from "Compilers: Principles, Techniques, and Tools"
150 * by Aho, Sethi, & Ullman (a.k.a. "The Dragon Book", 2nd edition.)
151 */
152 static size_t
153 hashpjw(struct value *key, size_t table_size) {
154 char *p;
155 unsigned long int h = 0, g;
156
157 /*
158 * XXX ecks ecks ecks XXX
159 * This is naff... for certain values this will work.
160 * For others, it won't...
161 */
162 if (key->type == VALUE_INTEGER ||
163 key->type == VALUE_BOOLEAN ||
164 key->type == VALUE_ATOM) {
165 for (p = (char *)key; p - (char *)key < sizeof(int); p++) {
166 h = (h << 4) + (*p);
167 if ((g = h & 0xf0000000))
168 h = (h ^ (g >> 24)) ^ g;
169 }
170 } else {
171 assert("key no good" == NULL);
172 }
173
174 return(h % table_size);
175 }
176
177 /*
178 * Create a new bucket (not called directly by client code.)
179 */
180 static struct chain *
181 chain_new(struct value *key, struct value *value)
182 {
183 struct chain *c;
184
185 c = bhuna_malloc(sizeof(struct chain));
186
187 c->next = NULL;
188 c->key = key;
189 c->value = value;
190
191 return(c);
192 }
193
194 /*
195 * Locate the bucket number a particular key would be located in, and the
196 * chain link itself if such a key exists (or NULL if it could not be found.)
197 */
198 static void
199 dict_locate(struct dict *d, struct value *key,
200 size_t *b_index, struct chain **c)
201 {
202 *b_index = hashpjw(key, d->num_buckets);
203 for (*c = d->bucket[*b_index]; *c != NULL; *c = (*c)->next) {
204 if (value_equal(key, (*c)->key))
205 break;
206 }
207 }
208
209 /*** OPERATIONS ***/
210
211 /*
212 * Retrieve a value from a dictionary, given its key.
213 */
214 struct value *
215 dict_fetch(struct dict *d, struct value *k)
216 {
217 struct chain *c;
218 size_t i;
219
220 dict_locate(d, k, &i, &c);
221 if (c != NULL) {
222 value_grab(c->value);
223 return(c->value);
224 } else {
225 return(NULL);
226 }
227 }
228
229 /*
230 * Insert a value into a dictionary.
231 */
232 void
233 dict_store(struct dict *d, struct value *k, struct value *v)
234 {
235 struct chain *c;
236 size_t i;
237
238 dict_locate(d, k, &i, &c);
239 if (c == NULL) {
240 /* Chain does not exist, add a new one. */
241 value_grab(k);
242 value_grab(v);
243 c = chain_new(k, v);
244 c->next = d->bucket[i];
245 d->bucket[i] = c;
246 } else {
247 /* Chain already exists, replace the value. */
248 value_release(c->value);
249 value_grab(v);
250 c->value = v;
251 }
252 }
253
254 int
255 dict_exists(struct dict *d, struct value *key)
256 {
257 struct value *v;
258
259 v = dict_fetch(d, key);
260 return(v != NULL);
261 }
262
263 /*
264 * Finds the next bucket with data in it.
265 * If d->cursor == NULL after this, there is no more data.
266 */
267 static void
268 dict_advance(struct dict *d)
269 {
270 while (d->cursor == NULL) {
271 if (d->cur_bucket == d->num_buckets - 1) {
272 /* We're at eof. Do nothing. */
273 break;
274 } else {
275 d->cur_bucket++;
276 d->cursor = d->bucket[d->cur_bucket];
277 }
278 }
279 }
280
281 void
282 dict_rewind(struct dict *d)
283 {
284 d->cur_bucket = 0;
285 d->cursor = d->bucket[d->cur_bucket];
286 dict_advance(d);
287 }
288
289 int
290 dict_eof(struct dict *d)
291 {
292 return(d->cursor == NULL);
293 }
294
295 struct value *
296 dict_getkey(struct dict *d)
297 {
298 if (d->cursor == NULL) {
299 return(NULL);
300 } else {
301 /* XXX grab? */
302 return(d->cursor->key);
303 }
304 }
305
306 void
307 dict_next(struct dict *d)
308 {
309 if (d->cursor != NULL)
310 d->cursor = d->cursor->next;
311 dict_advance(d);
312 }
313
314 size_t
315 dict_size(struct dict *d)
316 {
317 struct chain *c;
318 int bucket_no;
319 size_t count = 0;
320
321 for (bucket_no = 0; bucket_no < d->num_buckets; bucket_no++) {
322 for (c = d->bucket[bucket_no]; c != NULL; c = c->next)
323 count++;
324 }
325
326 return(count);
327 }
328
329 /*** debugging ***/
330
331 void
332 dict_dump(struct dict *d)
333 {
334 #ifdef DEBUG
335 printf("dict[%08lx]", (unsigned long)d);
336 #endif
337 }
+0
-76
src/dict.h less more
0 /*
1 * Copyright (c) 2004 The DragonFly Project. All rights reserved.
2 *
3 * This code is derived from software contributed to The DragonFly Project
4 * by Chris Pressey <cpressey@catseye.mine.nu>.
5 *
6 * Redistribution and use in source and binary forms, with or without
7 * modification, are permitted provided that the following conditions
8 * are met:
9 *
10 * 1. Redistributions of source code must retain the above copyright
11 * notice, this list of conditions and the following disclaimer.
12 * 2. Redistributions in binary form must reproduce the above copyright
13 * notice, this list of conditions and the following disclaimer in
14 * the documentation and/or other materials provided with the
15 * distribution.
16 * 3. Neither the name of The DragonFly Project nor the names of its
17 * contributors may be used to endorse or promote products derived
18 * from this software without specific, prior written permission.
19 *
20 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21 * ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
23 * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
24 * COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
25 * INCIDENTAL, SPECIAL, EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING,
26 * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
27 * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
28 * AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
29 * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
30 * OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
31 * SUCH DAMAGE.
32 */
33
34 /*
35 * dict.c
36 * $Id$
37 * Routines to manipulate Bhuna dictionaries.
38 */
39
40 #ifndef __DICT_H_
41 #define __DICT_H_
42
43 struct value;
44
45 struct dict {
46 struct chain **bucket;
47 struct chain *cursor;
48 int cur_bucket;
49 int num_buckets;
50 };
51
52 struct chain {
53 struct chain *next;
54 struct value *key;
55 struct value *value;
56 };
57
58 struct dict *dict_new(void);
59 struct dict *dict_dup(struct dict *);
60 void dict_free(struct dict *);
61
62 struct value *dict_fetch(struct dict *, struct value *);
63 int dict_exists(struct dict *, struct value *);
64 void dict_store(struct dict *, struct value *, struct value *);
65
66 void dict_rewind(struct dict *);
67 int dict_eof(struct dict *);
68 struct value *dict_getkey(struct dict *);
69 void dict_next(struct dict *);
70
71 size_t dict_size(struct dict *);
72
73 void dict_dump(struct dict *);
74
75 #endif /* !__DICT_H_ */
+18
-0
src/driver/Makefile less more
0 CFLAGS+=-I../lib
1
2 .include "../Makefile.inc"
3
4 all: bhuna
5
6 bhuna: main.o
7 gcc main.o -L../lib -lbhuna -o bhuna
8
9 main.o: main.c
10 gcc $(CFLAGS) -c main.c -o main.o
11
12 clean:
13 rm -f bhuna *.o *.so
14
15 strip: bhuna
16 strip bhuna
17 ls -lah bhuna
+213
-0
src/driver/main.c less more
0 #include <assert.h>
1 #include <stdio.h>
2 #include <stdlib.h>
3 #include <unistd.h>
4
5 #include "mem.h"
6 #include "scan.h"
7 #include "parse.h"
8 #include "symbol.h"
9 #include "ast.h"
10 #include "builtin.h"
11 #include "value.h"
12 #include "activation.h"
13 #include "vm.h"
14 #include "type.h"
15 #include "report.h"
16 #include "gc.h"
17 #include "trace.h"
18 #include "process.h"
19
20 #ifdef POOL_VALUES
21 #include "pool.h"
22 #endif
23
24 #ifdef DEBUG
25 #define OPTS "cdgG:lmnopsvy"
26 #define RUN_PROGRAM run_program
27 #else
28 #define OPTS "G:"
29 #define RUN_PROGRAM 1
30 #endif
31
32 struct activation *global_ar;
33
34 extern int gc_trigger;
35 extern int gc_target;
36
37 void
38 usage(char **argv)
39 {
40 fprintf(stderr, "Usage: %s [-" OPTS "] source\n",
41 argv[0]);
42 #ifdef DEBUG
43 fprintf(stderr, " -c: trace process context switching\n");
44 fprintf(stderr, " -d: trace pooling\n");
45 fprintf(stderr, " -g: trace garbage collection\n");
46 #endif
47 fprintf(stderr, " -G int: set garbage collection threshold\n");
48 #ifdef DEBUG
49 fprintf(stderr, " -l: trace bytecode generation (implies -x)\n");
50 fprintf(stderr, " -m: trace virtual machine\n");
51 fprintf(stderr, " -n: don't actually run program\n");
52 fprintf(stderr, " -o: trace allocations\n");
53 fprintf(stderr, " -p: dump program AST before run\n");
54 fprintf(stderr, " -s: dump symbol table before run\n");
55 fprintf(stderr, " -v: trace activation records\n");
56 fprintf(stderr, " -y: trace type inference\n");
57 #endif
58 exit(1);
59 }
60
61 int
62 main(int argc, char **argv)
63 {
64 char **real_argv = argv;
65 struct scan_st *sc;
66 struct symbol_table *stab;
67 struct ast *a;
68 char *source = NULL;
69 int opt;
70 int err_count = 0;
71 #ifdef DEBUG
72 int run_program = 1;
73 int dump_symbols = 0;
74 int dump_program = 0;
75 #endif
76
77 #ifdef DEBUG
78 setvbuf(stdout, NULL, _IOLBF, 0);
79 #endif
80
81 /*
82 * Get command-line arguments.
83 */
84 while ((opt = getopt(argc, argv, OPTS)) != -1) {
85 switch(opt) {
86 #ifdef DEBUG
87 case 'c':
88 trace_scheduling++;
89 break;
90 #ifdef POOL_VALUES
91 case 'd':
92 trace_pool++;
93 break;
94 #endif
95 case 'g':
96 trace_gc++;
97 break;
98 #endif
99 case 'G':
100 gc_trigger = atoi(optarg);
101 break;
102 #ifdef DEBUG
103 case 'l':
104 trace_gen++;
105 break;
106 case 'm':
107 trace_vm++;
108 break;
109 case 'n':
110 run_program = 0;
111 break;
112 case 'o':
113 trace_valloc++;
114 break;
115 case 'p':
116 dump_program = 1;
117 break;
118 case 's':
119 dump_symbols = 1;
120 break;
121 case 'v':
122 trace_activations++;
123 break;
124 case 'y':
125 trace_type_inference++;
126 break;
127 #endif
128 case '?':
129 default:
130 usage(argv);
131 }
132 }
133 argc -= optind;
134 argv += optind;
135
136 if (*argv != NULL)
137 source = *argv;
138 else
139 usage(real_argv);
140
141 #ifdef POOL_VALUES
142 value_pool_new();
143 #endif
144
145 gc_target = gc_trigger;
146 if ((sc = scan_open(source)) != NULL) {
147 stab = symbol_table_new(NULL, 0);
148 global_ar = activation_new_on_heap(100, NULL, NULL);
149 register_std_builtins(stab);
150 report_start();
151 a = parse_program(sc, stab);
152 scan_close(sc);
153 #ifdef DEBUG
154 if (dump_symbols)
155 symbol_table_dump(stab, 1);
156 if (dump_program) {
157 ast_dump(a, 0);
158 }
159 #endif
160 #ifndef DEBUG
161 symbol_table_free(stab);
162 types_free();
163 #endif
164 err_count = report_finish();
165 if (err_count == 0) {
166 struct vm *vm;
167 struct process *p;
168 unsigned char *program;
169
170 program = bhuna_malloc(16384);
171 ast_gen(&program, a);
172 vm = vm_new(program, 16384);
173 vm_set_pc(vm, program);
174 vm->current_ar = global_ar;
175 p = process_new(vm);
176 /* ast_dump(a, 0); */
177 if (RUN_PROGRAM) {
178 process_scheduler();
179 }
180 vm_free(vm);
181 bhuna_free(program);
182 /*value_dump_global_table();*/
183 }
184
185 ast_free(a); /* XXX move on up */
186 /* gc(); */ /* actually do a full blow out at the end */
187 /* activation_free_from_stack(global_ar); */
188 #ifdef DEBUG
189 symbol_table_free(stab);
190 types_free();
191 if (trace_valloc > 0) {
192 value_dump_global_table();
193 printf("Created: %8d\n", num_vars_created);
194 printf("Cached: %8d\n", num_vars_cached);
195 printf("Freed: %8d\n", num_vars_freed);
196 }
197 if (trace_activations > 0) {
198 printf("AR's alloc'ed: %8d\n", activations_allocated);
199 printf("AR's freed: %8d\n", activations_freed);
200 }
201 #ifdef POOL_VALUES
202 if (trace_pool > 0) {
203 pool_report();
204 }
205 #endif
206 #endif
207 return(0);
208 } else {
209 fprintf(stderr, "Can't open `%s'\n", source);
210 return(1);
211 }
212 }
+0
-461
src/eval.c less more
0 #ifdef RECURSIVE_AST_EVALUATOR
1
2 #include <assert.h>
3 #include <stdio.h>
4 #include <stdlib.h>
5 #include <string.h>
6
7 #include "ast.h"
8 #include "value.h"
9 #include "list.h"
10 #include "closure.h"
11 #include "activation.h"
12 #include "builtin.h"
13
14 #ifdef DEBUG
15 #include "symbol.h"
16
17 extern int trace_assignments;
18 extern int trace_calls;
19 extern int trace_ast;
20 extern int trace_closures;
21 #endif
22
23 extern struct activation *current_ar;
24
25 static struct value *initializer;
26
27 void
28 ast_eval_init(void)
29 {
30 initializer = value_new_integer(76);
31 }
32
33 /*** OPERATIONS ***/
34
35 /*
36 * Fill out an activation record with arguments.
37 * Unlike ast_eval(), this is iterative.
38 */
39 static void
40 ast_fillout(struct ast *a, struct activation *ar)
41 {
42 struct value *v;
43 int idxp;
44
45 for (idxp = 0; a != NULL; a = a->u.arg.right) {
46 assert(a->type == AST_ARG);
47 v = NULL;
48 ast_eval(a->u.arg.left, &v);
49 activation_set_value(ar, idxp++, 0, v);
50 value_release(v);
51 }
52
53 /*
54 while (idxp < ar->size) {
55 // printf("unfilled local or temporary @ %d\n", idxp);
56 activation_set_value(ar, idxp++, 0, initializer);
57 }
58 */
59 }
60
61 /*** EVALUATOR ***/
62
63 /*
64 * a is roughly analogous to the program counter (PC.)
65 *
66 * v is roughly analogous to the accumulator (A) or top of stack (ToS).
67 */
68 void
69 ast_eval(struct ast *a, struct value **v)
70 {
71 struct value *l = NULL, *r = NULL, *lv = NULL;
72 /* struct value **q = NULL; */
73 struct activation *new_ar = NULL;
74 int i;
75
76 if (a == NULL)
77 return;
78
79 #ifdef DEBUG
80 if (trace_ast) {
81 printf(">>> ENTERING %s[0x%08lx]\n", ast_name(a), (unsigned long)a);
82 }
83 #endif
84
85 switch (a->type) {
86 case AST_LOCAL:
87 /*
88 printf("index = %d, upcount = %d\n",
89 a->u.local.index, a->u.local.upcount);
90 activation_dump(current_ar, 0);
91 printf("\n");
92 */
93 lv = activation_get_value(current_ar,
94 a->u.local.index, a->u.local.upcount);
95 assert(lv != NULL);
96 value_set_from_value(v, lv);
97 /*value_release(lv);*/
98 break;
99 case AST_VALUE:
100 value_set_from_value(v, a->u.value.value);
101 if (*v != NULL && (*v)->type == VALUE_CLOSURE) {
102 #ifdef DEBUG
103 if (trace_closures) {
104 printf("Freshening ");
105 closure_dump((*v)->v.k);
106 printf(" with ");
107 activation_dump(current_ar, 1);
108 printf("\n");
109 }
110 #endif
111 (*v)->v.k->ar = current_ar;
112 }
113 /*value_release(a->u.value.value);*/
114 break;
115 case AST_BUILTIN:
116 ast_eval(a->u.builtin.left, &l);
117 ast_eval(a->u.builtin.right, &r);
118
119 /*
120 switch (a->u.builtin.bi->fn) {
121 case builtin_not:
122 case builtin_and:
123 case builtin_or:
124
125 case builtin_equ:
126 case builtin_neq:
127 case builtin_gt:
128 case builtin_lt:
129 case builtin_gte:
130 case builtin_lte:
131
132 case builtin_add:
133 case builtin_mul:
134 case builtin_sub:
135 case builtin_div:
136 case builtin_mod:
137 default:
138 break;
139 }
140 */
141
142 #ifdef INLINE_BUILTINS
143 switch (a->u.builtin.bi->index) {
144 case INDEX_BUILTIN_NOT:
145 if (l->type == VALUE_BOOLEAN) {
146 value_set_boolean(v, !l->v.b);
147 } else {
148 value_set_error(v, "type mismatch");
149 }
150 break;
151 case INDEX_BUILTIN_AND:
152 if (l->type == VALUE_BOOLEAN && r->type == VALUE_BOOLEAN) {
153 value_set_boolean(v, l->v.b && r->v.b);
154 } else {
155 value_set_error(v, "type mismatch");
156 }
157 break;
158 case INDEX_BUILTIN_OR:
159 if (l->type == VALUE_BOOLEAN && r->type == VALUE_BOOLEAN) {
160 value_set_boolean(v, l->v.b || r->v.b);
161 } else {
162 value_set_error(v, "type mismatch");
163 }
164 break;
165
166 case INDEX_BUILTIN_EQU:
167 if (l->type == VALUE_INTEGER && r->type == VALUE_INTEGER) {
168 value_set_boolean(v, l->v.i == r->v.i);
169 } else {
170 value_set_error(v, "type mismatch");
171 }
172 break;
173 case INDEX_BUILTIN_NEQ:
174 if (l->type == VALUE_INTEGER && r->type == VALUE_INTEGER) {
175 value_set_boolean(v, l->v.i != r->v.i);
176 } else {
177 value_set_error(v, "type mismatch");
178 }
179 break;
180 case INDEX_BUILTIN_GT:
181 if (l->type == VALUE_INTEGER && r->type == VALUE_INTEGER) {
182 value_set_boolean(v, l->v.i > r->v.i);
183 } else {
184 value_set_error(v, "type mismatch");
185 }
186 break;
187 case INDEX_BUILTIN_LT:
188 if (l->type == VALUE_INTEGER && r->type == VALUE_INTEGER) {
189 value_set_boolean(v, l->v.i < r->v.i);
190 } else {
191 value_set_error(v, "type mismatch");
192 }
193 break;
194 case INDEX_BUILTIN_GTE:
195 if (l->type == VALUE_INTEGER && r->type == VALUE_INTEGER) {
196 value_set_boolean(v, l->v.i >= r->v.i);
197 } else {
198 value_set_error(v, "type mismatch");
199 }
200 break;
201 case INDEX_BUILTIN_LTE:
202 if (l->type == VALUE_INTEGER && r->type == VALUE_INTEGER) {
203 value_set_boolean(v, l->v.i <= r->v.i);
204 } else {
205 value_set_error(v, "type mismatch");
206 }
207 break;
208
209 case INDEX_BUILTIN_ADD:
210 if (l->type == VALUE_INTEGER && r->type == VALUE_INTEGER) {
211 value_set_integer(v, l->v.i + r->v.i);
212 } else {
213 value_set_error(v, "type mismatch");
214 }
215 break;
216 case INDEX_BUILTIN_MUL:
217 if (l->type == VALUE_INTEGER && r->type == VALUE_INTEGER) {
218 value_set_integer(v, l->v.i * r->v.i);
219 } else {
220 value_set_error(v, "type mismatch");
221 }
222 break;
223 case INDEX_BUILTIN_SUB:
224 if (l->type == VALUE_INTEGER && r->type == VALUE_INTEGER) {
225 value_set_integer(v, l->v.i - r->v.i);
226 } else {
227 value_set_error(v, "type mismatch");
228 }
229 break;
230 case INDEX_BUILTIN_DIV:
231 if (l->type == VALUE_INTEGER && r->type == VALUE_INTEGER) {
232 if (r->v.i == 0)
233 value_set_error(v, "division by zero");
234 else
235 value_set_integer(v, l->v.i / r->v.i);
236 } else {
237 value_set_error(v, "type mismatch");
238 }
239 break;
240 case INDEX_BUILTIN_MOD:
241 if (l->type == VALUE_INTEGER && r->type == VALUE_INTEGER) {
242 if (r->v.i == 0)
243 value_set_error(v, "modulo by zero");
244 else
245 value_set_integer(v, l->v.i % r->v.i);
246 } else {
247 value_set_error(v, "type mismatch"); }
248 break;
249
250 default:
251 #endif
252 /*printf("doing builtin %s\n", a->u.builtin.bi->name);*/
253 new_ar = activation_new(a->u.builtin.bi->arity, current_ar, NULL);
254 if (a->u.builtin.bi->arity > 0) {
255 activation_set_value(new_ar, 0, 0, l);
256 if (a->u.builtin.bi->arity > 1) {
257 activation_set_value(new_ar, 1, 0, r);
258 }
259 }
260 a->u.builtin.bi->fn(new_ar, v);
261 activation_free(new_ar);
262 #ifdef INLINE_BUILTINS
263 break;
264 }
265 #endif
266 value_release(l);
267 value_release(r);
268 break;
269 case AST_APPLY:
270 /*
271 * Get the function we're being asked to apply.
272 */
273 ast_eval(a->u.apply.left, &l);
274 assert(l->type == VALUE_CLOSURE);
275
276 /*
277 * Create a new activation record apropos to l.
278 * Include the closure's environment as the
279 * lexical link of the activation record.
280 *
281 * An optimization: if the closure we are executing here
282 * contains no closures of its own, this activation record
283 * will never be used by any other closure, so we don't
284 * have to keep it on the heap nor garbage collect it.
285 * We allocate it on the (C) stack instead.
286 */
287 if (l->v.k->cc == 0) {
288 /*printf("stack allocation!\n");*/
289 new_ar = alloca(sizeof(struct activation) +
290 sizeof(struct value *) * l->v.k->arity);
291 bzero(new_ar, sizeof(struct activation) +
292 sizeof(struct value *) * l->v.k->arity);
293 new_ar->size = l->v.k->arity;
294 new_ar->caller = current_ar;
295 new_ar->enclosing = l->v.k->ar;
296 new_ar->marked = 0;
297 } else {
298 new_ar = activation_new(l->v.k->arity,
299 current_ar, l->v.k->ar);
300 }
301
302 /*
303 * Now, fill out that activation record with the
304 * supplied arguments.
305 *
306 * Note that, because ast_fillout() is mutually recursive with
307 * ast_eval(), and thus another AST_APPLY could be
308 * encountered, which could cause a new activation record
309 * to be created, which in turn could trigger the garbage
310 * collector, we have deferred registering the new activation
311 * record with the garbage collector until after this has
312 * finished.
313 */
314 ast_fillout(a->u.apply.right, new_ar);
315 /*
316 printf(":: filled out:\n");
317 activation_dump(new_ar, 1);
318 printf("\n");
319 */
320
321 #ifdef DEBUG
322 if (trace_calls) {
323 printf("---> call:");
324 value_print(l);
325 printf("(");
326 activation_dump(current_ar, 1);
327 printf(")\n");
328 }
329 #endif
330 /*
331 * On the other hand, if the closure we are executing here
332 * DOES contains closures of its own, we DO have to
333 * register it with the garbage collector.
334 */
335 if (l->v.k->cc > 0)
336 activation_register(new_ar);
337
338 /*
339 * Evaluate it, under the new activation record.
340 */
341 current_ar = new_ar;
342 ast_eval(l->v.k->ast, v);
343 assert(current_ar == new_ar);
344 current_ar = current_ar->caller;
345
346 if (l->v.k->cc == 0) {
347 for (i = 0; i < l->v.k->arity; i++) {
348 value_release(
349 ((struct value **)((char *)new_ar +
350 sizeof(struct activation)))[i]
351 );
352 }
353 }
354
355 #ifdef DEBUG
356 if (trace_calls) {
357 printf("<--- call done, retval=");
358 value_print(*v);
359 printf("\n");
360 }
361 #endif
362
363 value_release(l);
364 break;
365 case AST_ARG:
366 assert("this should never happen" == NULL);
367 /*value_set_list(v);
368 ast_flatten(a, v);*/
369 break;
370 case AST_STATEMENT:
371 ast_eval(a->u.statement.left, &l);
372 value_release(l);
373 ast_eval(a->u.statement.right, v);
374 break;
375 case AST_ASSIGNMENT:
376 ast_eval(a->u.assignment.right, v);
377 assert(a->u.assignment.left != NULL);
378 assert(a->u.assignment.left->type == AST_LOCAL);
379
380 activation_set_value(current_ar,
381 a->u.assignment.left->u.local.index,
382 a->u.assignment.left->u.local.upcount,
383 *v);
384 #ifdef DEBUG
385 if (trace_assignments) {
386 symbol_dump(a->u.assignment.left->u.local.sym, 1);
387 printf(":=");
388 value_print(*v);
389 printf("\n");
390 }
391 #endif
392 break;
393 case AST_CONDITIONAL:
394 /*
395 l = activation_get_value(current_ar,
396 a->u.conditional.index, 0);
397 */
398
399 /*
400 q = &((struct value **)((char *)current_ar +
401 sizeof(struct activation)))[a->u.conditional.index];
402 */
403 ast_eval(a->u.conditional.test, &l);
404
405 if (l == NULL || l->type != VALUE_BOOLEAN) {
406 value_set_error(v, "type mismatch");
407 } else {
408 if (l->v.b) {
409 ast_eval(a->u.conditional.yes, v);
410 } else if (a->u.conditional.no != NULL) {
411 ast_eval(a->u.conditional.no, v);
412 } else {
413 /*
414 value_set_error(v, "missing else");
415 */
416 }
417 }
418 value_release(l);
419 break;
420 case AST_WHILE_LOOP:
421 for (;;) {
422 ast_eval(a->u.while_loop.test, &l);
423 if (l == NULL || l->type != VALUE_BOOLEAN) {
424 value_release(l);
425 value_set_error(v, "type mismatch");
426 break;
427 } else {
428 /*
429 printf("WHILE: test=");
430 value_print(l);
431 printf("\n");
432 */
433 if (!l->v.b) {
434 /*
435 * `while' condition evaluated to false.
436 */
437 value_release(l);
438 break;
439 }
440 ast_eval(a->u.while_loop.body, v);
441 /*
442 printf("WHILE: body=");
443 value_print(*v);
444 printf("\n");
445 */
446 }
447 }
448 break;
449 }
450
451 #ifdef DEBUG
452 if (trace_ast) {
453 printf("<<< LEAVING %s[0x%08lx] w/value=", ast_name(a), (unsigned long)a);
454 value_print(*v);
455 printf("\n");
456 }
457 #endif
458 }
459
460 #endif /* RECURSIVE_AST_EVALUATOR */
+0
-299
src/gen.c less more
0 #include <assert.h>
1 #include <stdio.h>
2 #include <stdlib.h>
3 #include <string.h>
4
5 #include "vm.h"
6 #include "ast.h"
7 #include "value.h"
8 #include "list.h"
9 #include "closure.h"
10 #include "activation.h"
11 #include "builtin.h"
12
13 extern int trace_gen;
14
15 static vm_label_t gptr;
16 unsigned char program[65536];
17
18 vm_label_t patch_stack[4096];
19 int psp = 0;
20
21 unsigned char *last_ins_at = NULL;
22 unsigned char last_ins = 255;
23
24 /*** backpatcher ***/
25
26 static int
27 request_backpatch(vm_label_t *bp)
28 {
29 #ifdef DEBUG
30 if (trace_gen)
31 printf("[--> #%d]", *bp - program);
32 #endif
33 patch_stack[psp++] = *bp;
34 *bp += sizeof(vm_label_t);
35 return(psp - 1);
36 }
37
38 static void
39 backpatch(int bpid)
40 {
41 vm_label_t bp;
42
43 bp = patch_stack[bpid];
44 *(vm_label_t *)bp = gptr;
45 #ifdef DEBUG
46 if (trace_gen)
47 printf("#%d: [<-- #%d] $%d:\n", gptr - program, bp - program, bpid);
48 #endif
49 }
50
51 /*** generators ***/
52
53 static void
54 gen(unsigned char ins)
55 {
56 last_ins_at = gptr;
57 *gptr++ = last_ins = ins;
58 }
59
60 static void
61 gen_push_value(struct value *v)
62 {
63 #ifdef DEBUG
64 if (trace_gen) {
65 printf("#%d: *PUSH_VALUE(", gptr - program);
66 value_print(v);
67 printf(")\n");
68 }
69 #endif
70
71 gen(INSTR_PUSH_VALUE);
72 value_grab(v);
73 *(((struct value **)gptr)++) = v;
74 }
75
76 static void
77 gen_push_local(int index, int upcount)
78 {
79 #ifdef DEBUG
80 if (trace_gen)
81 printf("#%d: *PUSH_LOCAL(%d,%d)\n", gptr - program, index, upcount);
82 #endif
83
84 gen(INSTR_PUSH_LOCAL);
85 *gptr++ = (unsigned char)index;
86 *gptr++ = (unsigned char)upcount;
87 }
88
89 static void
90 gen_pop_local(int index, int upcount)
91 {
92 #ifdef DEBUG
93 if (trace_gen)
94 printf("#%d: *POP_LOCAL(%d,%d)\n", gptr - program, index, upcount);
95 #endif
96
97 gen(INSTR_POP_LOCAL);
98 *gptr++ = (unsigned char)index;
99 *gptr++ = (unsigned char)upcount;
100 }
101
102 static void
103 gen_builtin(struct builtin *bi)
104 {
105 #ifdef DEBUG
106 if (trace_gen)
107 printf("#%d: *BUILTIN(%s)\n", gptr - program, bi->name);
108 #endif
109
110 gen(bi->index);
111 }
112
113 static void
114 gen_jz_bp(int *bpid)
115 {
116 #ifdef DEBUG
117 if (trace_gen)
118 printf("#%d: *JZ", gptr - program);
119 #endif
120 gen(INSTR_JZ);
121 *bpid = request_backpatch(&gptr);
122 #ifdef DEBUG
123 if (trace_gen)
124 printf("($%d)\n", *bpid);
125 #endif
126 }
127
128 static void
129 gen_jmp_bp(int *bpid)
130 {
131 #ifdef DEBUG
132 if (trace_gen)
133 printf("#%d: *JMP", gptr - program);
134 #endif
135 gen(INSTR_JMP);
136 *bpid = request_backpatch(&gptr);
137 #ifdef DEBUG
138 if (trace_gen)
139 printf("($%d)\n", *bpid);
140 #endif
141 }
142
143 static void
144 gen_jmp(vm_label_t label)
145 {
146 #ifdef DEBUG
147 if (trace_gen)
148 printf("#%d: *JMP", gptr - program);
149 #endif
150 gen(INSTR_JMP);
151 *(vm_label_t *)gptr = label;
152 gptr += sizeof(vm_label_t);
153 #ifdef DEBUG
154 if (trace_gen)
155 printf("(#%d)\n", label - program);
156 #endif
157 }
158
159 static void
160 gen_apply(void)
161 {
162 #ifdef DEBUG
163 if (trace_gen)
164 printf("#%d: *CALL\n", gptr - program);
165 #endif
166 gen(INSTR_CALL);
167 }
168
169 static void
170 gen_ret(void)
171 {
172 #ifdef DEBUG
173 if (trace_gen)
174 printf("#%d: *RET\n", gptr - program);
175 #endif
176 if (last_ins == INSTR_CALL) {
177 #ifdef DEBUG
178 if (trace_gen)
179 printf("*** ELIMINATING TAIL CALL\n");
180 #endif