Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 383 lines (315 sloc) 9.497 kB
18ac8f4 @rthelen Adding the Forth code which supports numbers and strings
authored
1 /*
2 * This file is part of arm-sim: http://madscientistroom.org/arm-sim
3 *
4 * Copyright (c) 2010 Randy Thelen. All rights reserved, and all wrongs
5 * reversed. (See the file COPYRIGHT for details.)
6 */
7
8 #include "forth.h"
9 #include "fobj.h"
10
11
12 const foptable_t op_table[FOBJ_NUM_TYPES] = {
dff1ab9 @rthelen Major clean up. Dumped felem_t and fstack_t data types. Instead, ta…
authored
13 { 0 }, // The zeroth entry is INVALID
75e6480 @rthelen Moving toward a unified word model where each word contains a pointer…
authored
14 { "number", NULL, NULL, NULL, fnum_print, fnum_cmp, NULL, NULL, fnum_add, fnum_sub },
15 { "string", NULL, NULL, fstr_free, fstr_print, fstr_cmp, NULL, fstr_fetch, fstr_add, fstr_sub },
16 { "table", NULL, ftable_visit, NULL, ftable_print, NULL, ftable_store, ftable_fetch },
17 { "array", NULL, farray_visit, farray_free, farray_print, NULL, farray_store, farray_fetch },
18 { "hash", NULL, fhash_visit, fhash_free, fhash_print, NULL, fhash_store, fhash_fetch },
19 { "stack", NULL, fstack_visit, fstack_free, fstack_print, NULL, fstack_store, fstack_fetch },
20 { "index", NULL, findex_visit, NULL, NULL, NULL, NULL, NULL },
94724f5 @rthelen Compiling words now works.
authored
21 { "word", NULL, fword_visit, fword_free, fword_print, NULL, NULL, NULL, NULL, NULL },
18ac8f4 @rthelen Adding the Forth code which supports numbers and strings
authored
22 };
23
2844d37 @rthelen Deleted the forth word 1 which was incorrectly creating a new object …
authored
24 #define NUM_OBJ_MEM 1024
18ac8f4 @rthelen Adding the Forth code which supports numbers and strings
authored
25
a1f3592 @rthelen Too close for missiles, switching to guns. Or, retain/release is too…
authored
26 struct fobj_mem_s {
27 uint32_t inuse_bitmap[NUM_OBJ_MEM / 32];
550e6d3 @rthelen Improving the memory manager by making object allocation a constant t…
authored
28 int num_free_objs;
29 uint16_t next_free[NUM_OBJ_MEM];
a1f3592 @rthelen Too close for missiles, switching to guns. Or, retain/release is too…
authored
30 fobj_t objs[NUM_OBJ_MEM];
31 };
32
33 static int fobj_obj_mem_index(fenv_t *f, fobj_t *p)
18ac8f4 @rthelen Adding the Forth code which supports numbers and strings
authored
34 {
550e6d3 @rthelen Improving the memory manager by making object allocation a constant t…
authored
35 fobj_mem_t *m = f->obj_memory;
36 if (p >= &m->objs[0] &&
37 p < &m->objs[NUM_OBJ_MEM]) {
38 return p - &m->objs[0];
a1f3592 @rthelen Too close for missiles, switching to guns. Or, retain/release is too…
authored
39 }
f505cb3 @rthelen Fixing up the assertion logic to be more clean. Yet to be added is a…
authored
40 FASSERT(0, "Only 1024 objects currently supported");
a1f3592 @rthelen Too close for missiles, switching to guns. Or, retain/release is too…
authored
41 return -1;
42 }
18ac8f4 @rthelen Adding the Forth code which supports numbers and strings
authored
43
a1f3592 @rthelen Too close for missiles, switching to guns. Or, retain/release is too…
authored
44 static int fobj_obj_index_used(fenv_t *f, int idx)
45 {
9d56c81 @rthelen Fixing a number of bugs in the memory garbage collector. Basically, …
authored
46 uint32_t bit = 1 << (idx & 31);
a1f3592 @rthelen Too close for missiles, switching to guns. Or, retain/release is too…
authored
47 int bitmap_i = idx >> 5;
550e6d3 @rthelen Improving the memory manager by making object allocation a constant t…
authored
48 fobj_mem_t *m = f->obj_memory;
18ac8f4 @rthelen Adding the Forth code which supports numbers and strings
authored
49
550e6d3 @rthelen Improving the memory manager by making object allocation a constant t…
authored
50 if (m->inuse_bitmap[bitmap_i] & bit) {
a1f3592 @rthelen Too close for missiles, switching to guns. Or, retain/release is too…
authored
51 return 1;
52 } else {
550e6d3 @rthelen Improving the memory manager by making object allocation a constant t…
authored
53 m->inuse_bitmap[bitmap_i] |= bit;
a1f3592 @rthelen Too close for missiles, switching to guns. Or, retain/release is too…
authored
54 return 0;
55 }
18ac8f4 @rthelen Adding the Forth code which supports numbers and strings
authored
56 }
57
a1f3592 @rthelen Too close for missiles, switching to guns. Or, retain/release is too…
authored
58 static int fobj_obj_mem_used(fenv_t *f, fobj_t *p)
18ac8f4 @rthelen Adding the Forth code which supports numbers and strings
authored
59 {
a1f3592 @rthelen Too close for missiles, switching to guns. Or, retain/release is too…
authored
60 int i = fobj_obj_mem_index(f, p);
61 return fobj_obj_index_used(f, i);
62 }
18ac8f4 @rthelen Adding the Forth code which supports numbers and strings
authored
63
550e6d3 @rthelen Improving the memory manager by making object allocation a constant t…
authored
64 static void fobj_obj_mem_init(fenv_t *f)
65 {
66 f->obj_memory = calloc(1, sizeof(*f->obj_memory));
67 fobj_mem_t *m = f->obj_memory;
68 m->num_free_objs = NUM_OBJ_MEM;
69 for (int i = 0; i < NUM_OBJ_MEM; i++) {
9d56c81 @rthelen Fixing a number of bugs in the memory garbage collector. Basically, …
authored
70 m->next_free[i] = NUM_OBJ_MEM - 1 - i;
550e6d3 @rthelen Improving the memory manager by making object allocation a constant t…
authored
71 }
72 }
73
066c5e9 @rthelen Preparing the higher level functions by giving the base more girth. Now
authored
74 fenv_t *fenv_new(void)
a1f3592 @rthelen Too close for missiles, switching to guns. Or, retain/release is too…
authored
75 {
066c5e9 @rthelen Preparing the higher level functions by giving the base more girth. Now
authored
76 fenv_t *f = calloc(1, sizeof(*f));
77
550e6d3 @rthelen Improving the memory manager by making object allocation a constant t…
authored
78 fobj_obj_mem_init(f);
9d56c81 @rthelen Fixing a number of bugs in the memory garbage collector. Basically, …
authored
79
80 f->hold_stack = fstack_new(f);
a1f3592 @rthelen Too close for missiles, switching to guns. Or, retain/release is too…
authored
81 f->dstack = fstack_new(f);
82 f->rstack = fstack_new(f);
e615979 @rthelen Adding the code to create a forth environment dictionary and add all …
authored
83 f->words = ftable_new(f);
9d56c81 @rthelen Fixing a number of bugs in the memory garbage collector. Basically, …
authored
84
85 fobj_hold_clear(f);
066c5e9 @rthelen Preparing the higher level functions by giving the base more girth. Now
authored
86
a1f3592 @rthelen Too close for missiles, switching to guns. Or, retain/release is too…
authored
87 return f;
88 }
18ac8f4 @rthelen Adding the Forth code which supports numbers and strings
authored
89
066c5e9 @rthelen Preparing the higher level functions by giving the base more girth. Now
authored
90 void fenv_free(fenv_t *f)
91 {
92 f->dstack = NULL;
93 f->rstack = NULL;
9d56c81 @rthelen Fixing a number of bugs in the memory garbage collector. Basically, …
authored
94 f->hold_stack = NULL;
95 f->running = NULL;
96 f->words = NULL;
97 f->new_words = NULL;
98 f->imm_words = NULL;
99 f->input_str = NULL;
100 f->current_compiling = NULL;
101
066c5e9 @rthelen Preparing the higher level functions by giving the base more girth. Now
authored
102 fobj_garbage_collection(f);
103 #ifdef DEBUG
104 for (int i = 0; i < NUM_OBJ_MEM/32; i++) {
105 ASSERT(f->obj_memory->inuse_bitmap[i] == 0);
106 }
107 #endif
108 }
109
9d56c81 @rthelen Fixing a number of bugs in the memory garbage collector. Basically, …
authored
110 #if DEBUG_MISSING_OBJECTS
111 fobj_t *fobj_findp = NULL;
112 fobj_t *fobj_foundp = NULL;
113
114 void fobj_find(fenv_t *f, fobj_t *p)
115 {
116 fobj_findp = p;
117 fobj_foundp = NULL;
118 fobj_mem_t *m = f->obj_memory;
119
120 bzero(m->inuse_bitmap, NUM_OBJ_MEM/8);
121
122 fobj_visit(f, f->dstack);
123 fobj_visit(f, f->rstack);
124 fobj_visit(f, f->current_compiling); // during colon definitions
125 fobj_visit(f, f->new_words);
126 fobj_visit(f, f->words);
127 fobj_visit(f, f->input_str);
128 fobj_visit(f, f->running);
129 fobj_visit(f, f->hold_stack);
130
131 ASSERT(!!fobj_foundp);
132 }
133 #endif /* DEBUG_MISSING_OBJECTS */
134
a1f3592 @rthelen Too close for missiles, switching to guns. Or, retain/release is too…
authored
135 fobj_t *fobj_new(fenv_t *f, int type)
136 {
328f69f @rthelen Adding words to support holding objects temporarily during execution …
authored
137 if (f->obj_memory->num_free_objs == 0) {
138 fobj_garbage_collection(f);
139 }
140
141 #ifdef DEBUG
142 /*
143 * DEBUG: Always garbage collect!
144 */
145
9d56c81 @rthelen Fixing a number of bugs in the memory garbage collector. Basically, …
authored
146 if (f->hold_stack) {
147 fobj_garbage_collection(f);
148 }
328f69f @rthelen Adding words to support holding objects temporarily during execution …
authored
149 #endif /* DEBUG */
150
550e6d3 @rthelen Improving the memory manager by making object allocation a constant t…
authored
151 fobj_mem_t *m = f->obj_memory;
9d56c81 @rthelen Fixing a number of bugs in the memory garbage collector. Basically, …
authored
152
153 #if DEBUG_MISSING_OBJECTS
154 if (m->num_free_objs == 0) {
155 for (int idx = 0; idx < NUM_OBJ_MEM; idx ++) {
156 fobj_find(f, &m->objs[idx]);
157 }
158 }
159 #endif /* DEBUG_MISSING_OBJECTS */
160
f505cb3 @rthelen Fixing up the assertion logic to be more clean. Yet to be added is a…
authored
161 FASSERT(m->num_free_objs > 0, "out of memory allocating a new fobj");
9d56c81 @rthelen Fixing a number of bugs in the memory garbage collector. Basically, …
authored
162
550e6d3 @rthelen Improving the memory manager by making object allocation a constant t…
authored
163 int i = --(m->num_free_objs);
164 int pi = m->next_free[i];
9d56c81 @rthelen Fixing a number of bugs in the memory garbage collector. Basically, …
authored
165 m->next_free[i] = 0;
550e6d3 @rthelen Improving the memory manager by making object allocation a constant t…
authored
166 fobj_t *p = &m->objs[pi];
167
168 p->type = type;
9d56c81 @rthelen Fixing a number of bugs in the memory garbage collector. Basically, …
authored
169
170 int r = fobj_obj_mem_used(f, p);
f505cb3 @rthelen Fixing up the assertion logic to be more clean. Yet to be added is a…
authored
171 ASSERT(!r); // "Just allocated an already in use block"
9d56c81 @rthelen Fixing a number of bugs in the memory garbage collector. Basically, …
authored
172
173 if (f->hold_stack) {
174 HOLD(p); // Hold newly allocated object
175 }
176
550e6d3 @rthelen Improving the memory manager by making object allocation a constant t…
authored
177 return p;
18ac8f4 @rthelen Adding the Forth code which supports numbers and strings
authored
178 }
179
a1f3592 @rthelen Too close for missiles, switching to guns. Or, retain/release is too…
authored
180 void fobj_visit(fenv_t *f, fobj_t *p)
18ac8f4 @rthelen Adding the Forth code which supports numbers and strings
authored
181 {
a1f3592 @rthelen Too close for missiles, switching to guns. Or, retain/release is too…
authored
182 if (!p) return;
dff1ab9 @rthelen Major clean up. Dumped felem_t and fstack_t data types. Instead, ta…
authored
183
9d56c81 @rthelen Fixing a number of bugs in the memory garbage collector. Basically, …
authored
184 #if DEBUG_MISSING_OBJECTS
185 if (fobj_findp == p) fobj_foundp = p;
186 if (fobj_foundp) return;
187 #endif /* DEBUG_MISSING_OBJECTS */
188
a1f3592 @rthelen Too close for missiles, switching to guns. Or, retain/release is too…
authored
189 if (fobj_obj_mem_used(f, p)) return;
18ac8f4 @rthelen Adding the Forth code which supports numbers and strings
authored
190
a1f3592 @rthelen Too close for missiles, switching to guns. Or, retain/release is too…
authored
191 if (op_table[p->type].visit) {
192 op_table[p->type].visit(f, p);
193 }
194 }
dff1ab9 @rthelen Major clean up. Dumped felem_t and fstack_t data types. Instead, ta…
authored
195
a1f3592 @rthelen Too close for missiles, switching to guns. Or, retain/release is too…
authored
196 void fobj_garbage_collection(fenv_t *f)
197 {
198 // Copy the in-use bitmap
199 // visit f->dstack and f->rstack
200 // Determine which objects are no longer used and call their free routine
550e6d3 @rthelen Improving the memory manager by making object allocation a constant t…
authored
201 uint32_t copy_inuse_bitmap[NUM_OBJ_MEM / 32];
202 int n = NUM_OBJ_MEM / 32;
203 fobj_mem_t *m = f->obj_memory;
9d56c81 @rthelen Fixing a number of bugs in the memory garbage collector. Basically, …
authored
204 int nbytes = sizeof(m->inuse_bitmap);
550e6d3 @rthelen Improving the memory manager by making object allocation a constant t…
authored
205
206 bcopy(m->inuse_bitmap, copy_inuse_bitmap, nbytes);
207 bzero(m->inuse_bitmap, nbytes);
a1f3592 @rthelen Too close for missiles, switching to guns. Or, retain/release is too…
authored
208
209 fobj_visit(f, f->dstack);
210 fobj_visit(f, f->rstack);
645543f @rthelen tyForth's biggest change to-date!!
authored
211 fobj_visit(f, f->current_compiling); // during colon definitions
328f69f @rthelen Adding words to support holding objects temporarily during execution …
authored
212 fobj_visit(f, f->new_words);
213 fobj_visit(f, f->words);
214 fobj_visit(f, f->input_str);
215 fobj_visit(f, f->running);
9d56c81 @rthelen Fixing a number of bugs in the memory garbage collector. Basically, …
authored
216 fobj_visit(f, f->hold_stack);
a1f3592 @rthelen Too close for missiles, switching to guns. Or, retain/release is too…
authored
217
550e6d3 @rthelen Improving the memory manager by making object allocation a constant t…
authored
218 for (int i = 0; i < n; i++) {
9d56c81 @rthelen Fixing a number of bugs in the memory garbage collector. Basically, …
authored
219 /*
220 * free will have bits set for items which the allocator had
221 * -thought- were in use (i.e., they had been allocated at some
222 * point in the past) but are no longer in use (i.e., they're inuse
223 * bit in m->inuse_bitmap[] is now zero).
224 *
225 * The algorithm works by noting that if a bit had been set
226 * previously (i.e., a bit is set in copy_inuse_bitmap[]), but is
227 * now clear (i.e., the bit is clear in m->inuse_bitmap[]), then we
228 * need to add that object to the free list.
229 */
230 uint32_t free = copy_inuse_bitmap[i] & ~m->inuse_bitmap[i];
550e6d3 @rthelen Improving the memory manager by making object allocation a constant t…
authored
231 if (!free) {
232 continue;
233 }
234
9d56c81 @rthelen Fixing a number of bugs in the memory garbage collector. Basically, …
authored
235 fobj_t *p = &m->objs[i * 32];
550e6d3 @rthelen Improving the memory manager by making object allocation a constant t…
authored
236 for (uint32_t bit = 1; free && bit; bit <<= 1, p++) {
237 if (!(free & bit)) {
a1f3592 @rthelen Too close for missiles, switching to guns. Or, retain/release is too…
authored
238 continue;
239 }
550e6d3 @rthelen Improving the memory manager by making object allocation a constant t…
authored
240
241 free ^= bit;
a1f3592 @rthelen Too close for missiles, switching to guns. Or, retain/release is too…
authored
242 if (op_table[p->type].free) {
243 op_table[p->type].free(f, p);
244 }
245 bzero(p, sizeof(*p));
550e6d3 @rthelen Improving the memory manager by making object allocation a constant t…
authored
246
247 int j = m->num_free_objs++;
248 int pj = p - &m->objs[0];
249 m->next_free[j] = pj;
a1f3592 @rthelen Too close for missiles, switching to guns. Or, retain/release is too…
authored
250 }
251 }
18ac8f4 @rthelen Adding the Forth code which supports numbers and strings
authored
252 }
253
9d56c81 @rthelen Fixing a number of bugs in the memory garbage collector. Basically, …
authored
254 fobj_t *fobj_hold(fenv_t *f, fobj_t *p)
328f69f @rthelen Adding words to support holding objects temporarily during execution …
authored
255 {
9d56c81 @rthelen Fixing a number of bugs in the memory garbage collector. Basically, …
authored
256 if (!p) return NULL;
328f69f @rthelen Adding words to support holding objects temporarily during execution …
authored
257 fstack_store(f, f->hold_stack, NULL, p);
9d56c81 @rthelen Fixing a number of bugs in the memory garbage collector. Basically, …
authored
258 return p;
328f69f @rthelen Adding words to support holding objects temporarily during execution …
authored
259 }
260
261 void fobj_hold_n(fenv_t *f, int n, ...)
262 {
263 va_list ap;
264
265 va_start(ap, n);
266 for (int i = 0; i < n; i++) {
267 fobj_hold(f, va_arg(ap, fobj_t *));
268 }
269 va_end(ap);
270 }
271
272 void fobj_hold_clear(fenv_t *f)
273 {
274 f->hold_stack->u.stack.sp = 0;
275 }
276
18ac8f4 @rthelen Adding the Forth code which supports numbers and strings
authored
277 void fobj_print(fenv_t *f, fobj_t *p)
278 {
75e6480 @rthelen Moving toward a unified word model where each word contains a pointer…
authored
279 if (!p) {
280 printf("(null)");
281 } else {
282 ASSERT(p->type > 0);
283 ASSERT(op_table[p->type].print);
18ac8f4 @rthelen Adding the Forth code which supports numbers and strings
authored
284
a1f3592 @rthelen Too close for missiles, switching to guns. Or, retain/release is too…
authored
285 #ifdef DEBUG
75e6480 @rthelen Moving toward a unified word model where each word contains a pointer…
authored
286 printf("Object %p: type = %d\n", p, p->type);
a1f3592 @rthelen Too close for missiles, switching to guns. Or, retain/release is too…
authored
287 #endif
75e6480 @rthelen Moving toward a unified word model where each word contains a pointer…
authored
288 op_table[p->type].print(f, p);
289 }
18ac8f4 @rthelen Adding the Forth code which supports numbers and strings
authored
290 }
291
dff1ab9 @rthelen Major clean up. Dumped felem_t and fstack_t data types. Instead, ta…
authored
292 fobj_t *fobj_add(fenv_t *f, fobj_t *op1, fobj_t *op2)
18ac8f4 @rthelen Adding the Forth code which supports numbers and strings
authored
293 {
f505cb3 @rthelen Fixing up the assertion logic to be more clean. Yet to be added is a…
authored
294 FASSERT(op_table[op1->type].add, "%s <> + not supported",
dff1ab9 @rthelen Major clean up. Dumped felem_t and fstack_t data types. Instead, ta…
authored
295 op_table[op1->type].type_name);
296
297 return op_table[op1->type].add(f, op1, op2);
18ac8f4 @rthelen Adding the Forth code which supports numbers and strings
authored
298 }
299
dff1ab9 @rthelen Major clean up. Dumped felem_t and fstack_t data types. Instead, ta…
authored
300 fobj_t *fobj_sub(fenv_t *f, fobj_t *op1, fobj_t *op2)
18ac8f4 @rthelen Adding the Forth code which supports numbers and strings
authored
301 {
f505cb3 @rthelen Fixing up the assertion logic to be more clean. Yet to be added is a…
authored
302 FASSERT(op_table[op1->type].sub, "%s <> - not supported",
dff1ab9 @rthelen Major clean up. Dumped felem_t and fstack_t data types. Instead, ta…
authored
303 op_table[op1->type].type_name);
304
305 return op_table[op1->type].sub(f, op1, op2);
306 }
307
308 fobj_t *fobj_fetch(fenv_t *f, fobj_t *addr, fobj_t *index)
309 {
f505cb3 @rthelen Fixing up the assertion logic to be more clean. Yet to be added is a…
authored
310 FASSERT(op_table[addr->type].fetch, "%s @ not supported",
dff1ab9 @rthelen Major clean up. Dumped felem_t and fstack_t data types. Instead, ta…
authored
311 op_table[addr->type].type_name);
312
313 return op_table[addr->type].fetch(f, addr, index);
18ac8f4 @rthelen Adding the Forth code which supports numbers and strings
authored
314 }
315
da93c76 @rthelen Adding support for store/fetch and lots of macros to simplify the tes…
authored
316 void fobj_store(fenv_t *f, fobj_t *addr, fobj_t *index, fobj_t *data)
317 {
f505cb3 @rthelen Fixing up the assertion logic to be more clean. Yet to be added is a…
authored
318 FASSERT(op_table[addr->type].store, "%s ! not supported",
da93c76 @rthelen Adding support for store/fetch and lots of macros to simplify the tes…
authored
319 op_table[addr->type].type_name);
320
321 op_table[addr->type].store(f, addr, index, data);
322 }
323
af150b2 @rthelen Several changes:
authored
324 int fobj_cmp(fenv_t *f, fobj_t *a, fobj_t *b)
325 {
326 if (a->type == b->type && op_table[a->type].cmp) {
327 return op_table[a->type].cmp(f, a, b);
328 } else {
329 if (a < b) return -1;
330 if (a == b) return 0;
331 else return 1;
332 }
333 }
334
335 int fobj_hash(fenv_t *f, fobj_t *a)
336 {
337 int hash = 0;
338 int entropy = a->type | a->type << 4;
339 unsigned char *p = (unsigned char *) a;
340
341 for (int i = 0; i < sizeof(fobj_t *); i++) {
342 hash += (hash << 3) + (p[i] ^ entropy);
343 }
344
345 return hash;
346 }
347
a1f3592 @rthelen Too close for missiles, switching to guns. Or, retain/release is too…
authored
348 fobj_t *findex_new(fenv_t *f, fobj_t *addr, fobj_t *index)
349 {
350 if (!index) return addr;
351
352 fobj_t *p = fobj_new(f, FOBJ_INDEX);
353 findex_t *i = &p->u.index;
354 i->addr = addr;
355 i->index = index;
356 return p;
357 }
358
359 void findex_visit(fenv_t *f, fobj_t *p)
360 {
361 findex_t *i = &p->u.index;
362 fobj_visit(f, i->addr);
363 fobj_visit(f, i->index);
364 }
365
da93c76 @rthelen Adding support for store/fetch and lots of macros to simplify the tes…
authored
366 int fobj_is_index(fenv_t *f, fobj_t *obj)
367 {
368 if (obj && obj->type == FOBJ_INDEX) {
369 return 1;
370 } else {
371 return 0;
372 }
373 }
e615979 @rthelen Adding the code to create a forth environment dictionary and add all …
authored
374
645543f @rthelen tyForth's biggest change to-date!!
authored
375 fobj_t *fstate_new(fenv_t *f, int state, int offset)
376 {
377 fobj_t *p = fobj_new(f, FOBJ_STATE);
378 fstate_t *s = &p->u.state;
379 s->state = state;
380 s->offset = offset;
381 return p;
382 }
Something went wrong with that request. Please try again.