48 |
{ |
{ |
49 |
int i; |
int i; |
50 |
|
|
51 |
env->gc_limit= 200; |
env->gc_limit= 400000; |
52 |
env->gc_count= 0; |
env->gc_count= 0; |
53 |
env->gc_ref= NULL; |
env->gc_ref= NULL; |
|
env->gc_protect= NULL; |
|
54 |
|
|
55 |
env->head= NULL; |
env->head= NULL; |
56 |
for(i= 0; i<HASHTBLSIZE; i++) |
for(i= 0; i<HASHTBLSIZE; i++) |
80 |
|
|
81 |
env->head= env->head->next; /* Remove the top stack item */ |
env->head= env->head->next; /* Remove the top stack item */ |
82 |
free(temp); /* Free the old top stack item */ |
free(temp); /* Free the old top stack item */ |
|
|
|
|
env->gc_limit--; |
|
83 |
} |
} |
84 |
|
|
85 |
/* Returns a pointer to a pointer to an element in the hash table. */ |
/* Returns a pointer to a pointer to an element in the hash table. */ |
123 |
nitem->next= env->gc_ref; |
nitem->next= env->gc_ref; |
124 |
env->gc_ref= nitem; |
env->gc_ref= nitem; |
125 |
|
|
126 |
env->gc_count++; |
env->gc_count+=sizeof(value); |
127 |
nval->gc_garb= 1; |
nval->gc.flag.mark= 0; |
128 |
|
nval->gc.flag.protect= 0; |
129 |
|
|
130 |
return nval; |
return nval; |
131 |
} |
} |
136 |
{ |
{ |
137 |
stackitem *iterator; |
stackitem *iterator; |
138 |
|
|
139 |
if(val->gc_garb==0) |
if(val->gc.flag.mark) |
140 |
return; |
return; |
141 |
|
|
142 |
val->gc_garb= 0; |
val->gc.flag.mark= 1; |
143 |
|
|
144 |
if(val->type==list) { |
if(val->type==list) { |
145 |
iterator= val->content.ptr; |
iterator= val->content.ptr; |
166 |
symbol *tsymb; |
symbol *tsymb; |
167 |
int i; |
int i; |
168 |
|
|
169 |
/* Mark protected values */ |
if(env->interactive){ |
170 |
iterator= env->gc_protect; |
printf("Garbage collecting.", env->gc_count, env->gc_limit); |
|
while(iterator!=NULL) { |
|
|
gc_mark(iterator->item); |
|
|
iterator= iterator->next; |
|
171 |
} |
} |
172 |
|
|
173 |
/* Mark values on stack */ |
/* Mark values on stack */ |
177 |
iterator= iterator->next; |
iterator= iterator->next; |
178 |
} |
} |
179 |
|
|
180 |
|
if(env->interactive){ |
181 |
|
printf("."); |
182 |
|
} |
183 |
|
|
184 |
/* Mark values in hashtable */ |
/* Mark values in hashtable */ |
185 |
for(i= 0; i<HASHTBLSIZE; i++) { |
for(i= 0; i<HASHTBLSIZE; i++) { |
186 |
tsymb= env->symbols[i]; |
tsymb= env->symbols[i]; |
191 |
} |
} |
192 |
} |
} |
193 |
|
|
194 |
|
if(env->interactive){ |
195 |
|
printf("."); |
196 |
|
} |
197 |
|
|
198 |
env->gc_count= 0; |
env->gc_count= 0; |
199 |
|
|
200 |
while(env->gc_ref!=NULL) { /* Sweep unused values */ |
while(env->gc_ref!=NULL) { /* Sweep unused values */ |
201 |
|
|
202 |
if(env->gc_ref->item->gc_garb) { |
if(!(env->gc_ref->item->gc.no_gc)){ /* neither mark nor protect */ |
203 |
|
|
204 |
switch(env->gc_ref->item->type) { /* Remove content */ |
switch(env->gc_ref->item->type) { /* Remove content */ |
205 |
case string: |
case string: |
218 |
free(env->gc_ref); /* Remove value */ |
free(env->gc_ref); /* Remove value */ |
219 |
env->gc_ref= titem; |
env->gc_ref= titem; |
220 |
continue; |
continue; |
221 |
|
} else { |
222 |
|
env->gc_count += sizeof(value); |
223 |
} |
} |
224 |
|
|
225 |
/* Keep values */ |
/* Keep values */ |
226 |
titem= env->gc_ref->next; |
titem= env->gc_ref->next; |
227 |
env->gc_ref->next= new_head; |
env->gc_ref->next= new_head; |
228 |
new_head= env->gc_ref; |
new_head= env->gc_ref; |
229 |
new_head->item->gc_garb= 1; |
new_head->item->gc.flag.mark= 0; |
230 |
env->gc_ref= titem; |
env->gc_ref= titem; |
|
env->gc_count++; |
|
231 |
} |
} |
232 |
|
|
233 |
env->gc_limit= env->gc_count*2; |
if (env->gc_limit < env->gc_count*2) |
234 |
|
env->gc_limit= env->gc_count*2; |
235 |
env->gc_ref= new_head; |
env->gc_ref= new_head; |
236 |
|
|
237 |
|
if(env->interactive){ |
238 |
|
printf("done\n"); |
239 |
|
} |
240 |
|
|
241 |
} |
} |
242 |
|
|
243 |
/* Protect values from GC */ |
/* Protect values from GC */ |
244 |
void protect(environment *env, value *val) |
void protect(value *val) |
245 |
{ |
{ |
246 |
stackitem *new_item= malloc(sizeof(stackitem)); |
stackitem *iterator; |
247 |
new_item->item= val; |
|
248 |
new_item->next= env->gc_protect; |
if(val->gc.flag.protect) |
249 |
env->gc_protect= new_item; |
return; |
250 |
|
|
251 |
|
val->gc.flag.protect= 1; |
252 |
|
|
253 |
|
if(val->type==list) { |
254 |
|
iterator= val->content.ptr; |
255 |
|
|
256 |
|
while(iterator!=NULL) { |
257 |
|
protect(iterator->item); |
258 |
|
iterator= iterator->next; |
259 |
|
} |
260 |
|
} |
261 |
} |
} |
262 |
|
|
263 |
/* Unprotect values from GC */ |
/* Unprotect values from GC */ |
264 |
void unprotect(environment *env) |
void unprotect(value *val) |
265 |
{ |
{ |
266 |
stackitem *temp= env->gc_protect; |
stackitem *iterator; |
267 |
env->gc_protect= env->gc_protect->next; |
|
268 |
free(temp); |
if(!(val->gc.flag.protect)) |
269 |
|
return; |
270 |
|
|
271 |
|
val->gc.flag.protect= 0; |
272 |
|
|
273 |
|
if(val->type==list) { |
274 |
|
iterator= val->content.ptr; |
275 |
|
|
276 |
|
while(iterator!=NULL) { |
277 |
|
unprotect(iterator->item); |
278 |
|
iterator= iterator->next; |
279 |
|
} |
280 |
|
} |
281 |
} |
} |
282 |
|
|
283 |
/* Push a value onto the stack */ |
/* Push a value onto the stack */ |
383 |
char *mangled; /* Mangled function name */ |
char *mangled; /* Mangled function name */ |
384 |
|
|
385 |
new_value= new_val(env); |
new_value= new_val(env); |
386 |
protect(env, new_value); |
protect(new_value); |
387 |
new_fvalue= new_val(env); |
new_fvalue= new_val(env); |
388 |
protect(env, new_fvalue); |
protect(new_fvalue); |
389 |
|
|
390 |
/* The new value is a symbol */ |
/* The new value is a symbol */ |
391 |
new_value->type= symb; |
new_value->type= symb; |
431 |
} |
} |
432 |
|
|
433 |
push_val(env, new_value); |
push_val(env, new_value); |
434 |
unprotect(env); unprotect(env); |
unprotect(new_value); unprotect(new_fvalue); |
435 |
} |
} |
436 |
|
|
437 |
/* Print newline. */ |
/* Print newline. */ |
624 |
env->err=3; |
env->err=3; |
625 |
return; |
return; |
626 |
} |
} |
627 |
protect(env, val); |
protect(val); |
628 |
toss(env); /* toss the symbol */ |
toss(env); /* toss the symbol */ |
629 |
if(env->err) return; |
if(env->err) return; |
630 |
push_val(env, val); /* Return its bound value */ |
push_val(env, val); /* Return its bound value */ |
631 |
unprotect(env); |
unprotect(val); |
632 |
} |
} |
633 |
|
|
634 |
/* If the top element is a symbol, determine if it's bound to a |
/* If the top element is a symbol, determine if it's bound to a |
670 |
/* If it's a list */ |
/* If it's a list */ |
671 |
case list: |
case list: |
672 |
temp_val= env->head->item; |
temp_val= env->head->item; |
673 |
protect(env, temp_val); |
protect(temp_val); |
674 |
|
|
675 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
676 |
iterator= (stackitem*)temp_val->content.ptr; |
iterator= (stackitem*)temp_val->content.ptr; |
679 |
push_val(env, iterator->item); |
push_val(env, iterator->item); |
680 |
|
|
681 |
if(env->head->item->type==symb |
if(env->head->item->type==symb |
682 |
&& strcmp(";", ((symbol*)(env->head->item->content.ptr))->id)==0) { |
&& (((symbol*)(env->head->item->content.ptr))->id[0] == ';')) { |
683 |
toss(env); |
toss(env); |
684 |
if(env->err) return; |
if(env->err) return; |
685 |
|
|
691 |
} |
} |
692 |
iterator= iterator->next; |
iterator= iterator->next; |
693 |
} |
} |
694 |
unprotect(env); |
unprotect(temp_val); |
695 |
return; |
return; |
696 |
|
|
697 |
default: |
default: |
735 |
|
|
736 |
iterator= env->head; |
iterator= env->head; |
737 |
pack= new_val(env); |
pack= new_val(env); |
738 |
protect(env, pack); |
protect(pack); |
739 |
|
|
740 |
if(iterator==NULL |
if(iterator==NULL |
741 |
|| (iterator->item->type==symb |
|| (iterator->item->type==symb |
766 |
push_val(env, pack); |
push_val(env, pack); |
767 |
rev(env); |
rev(env); |
768 |
|
|
769 |
unprotect(env); |
unprotect(pack); |
770 |
} |
} |
771 |
|
|
772 |
/* Relocate elements of the list on the stack. */ |
/* Relocate elements of the list on the stack. */ |
1064 |
&& env->head->next->item->type==string) { |
&& env->head->next->item->type==string) { |
1065 |
a_val= env->head->item; |
a_val= env->head->item; |
1066 |
b_val= env->head->next->item; |
b_val= env->head->next->item; |
1067 |
protect(env, a_val); protect(env, b_val); |
protect(a_val); protect(b_val); |
1068 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
1069 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
1070 |
len= strlen(a_val->content.ptr)+strlen(b_val->content.ptr)+1; |
len= strlen(a_val->content.ptr)+strlen(b_val->content.ptr)+1; |
1072 |
strcpy(new_string, b_val->content.ptr); |
strcpy(new_string, b_val->content.ptr); |
1073 |
strcat(new_string, a_val->content.ptr); |
strcat(new_string, a_val->content.ptr); |
1074 |
push_cstring(env, new_string); |
push_cstring(env, new_string); |
1075 |
unprotect(env); unprotect(env); |
unprotect(a_val); unprotect(b_val); |
1076 |
free(new_string); |
free(new_string); |
1077 |
|
|
1078 |
return; |
return; |
1273 |
stackitem *old_item, *new_item, *prev_item; |
stackitem *old_item, *new_item, *prev_item; |
1274 |
value *new_value; |
value *new_value; |
1275 |
|
|
1276 |
protect(env, old_value); |
protect(old_value); |
1277 |
new_value= new_val(env); |
new_value= new_val(env); |
1278 |
protect(env, new_value); |
protect(new_value); |
1279 |
new_value->type= old_value->type; |
new_value->type= old_value->type; |
1280 |
|
|
1281 |
switch(old_value->type){ |
switch(old_value->type){ |
1310 |
break; |
break; |
1311 |
} |
} |
1312 |
|
|
1313 |
unprotect(env); unprotect(env); |
unprotect(old_value); unprotect(new_value); |
1314 |
|
|
1315 |
return new_value; |
return new_value; |
1316 |
} |
} |
1406 |
} |
} |
1407 |
|
|
1408 |
loop= env->head->item; |
loop= env->head->item; |
1409 |
protect(env, loop); |
protect(loop); |
1410 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
1411 |
|
|
1412 |
test= env->head->item; |
test= env->head->item; |
1413 |
protect(env, test); |
protect(test); |
1414 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
1415 |
|
|
1416 |
do { |
do { |
1435 |
|
|
1436 |
} while(truth); |
} while(truth); |
1437 |
|
|
1438 |
unprotect(env); unprotect(env); |
unprotect(loop); unprotect(test); |
1439 |
} |
} |
1440 |
|
|
1441 |
|
|
1460 |
} |
} |
1461 |
|
|
1462 |
loop= env->head->item; |
loop= env->head->item; |
1463 |
protect(env, loop); |
protect(loop); |
1464 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
1465 |
|
|
1466 |
foo2= env->head->item->content.i; |
foo2= env->head->item->content.i; |
1484 |
foo1--; |
foo1--; |
1485 |
} |
} |
1486 |
} |
} |
1487 |
unprotect(env); |
unprotect(loop); |
1488 |
} |
} |
1489 |
|
|
1490 |
/* Variant of for-loop */ |
/* Variant of for-loop */ |
1506 |
} |
} |
1507 |
|
|
1508 |
loop= env->head->item; |
loop= env->head->item; |
1509 |
protect(env, loop); |
protect(loop); |
1510 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
1511 |
|
|
1512 |
foo= env->head->item; |
foo= env->head->item; |
1513 |
protect(env, foo); |
protect(foo); |
1514 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
1515 |
|
|
1516 |
iterator= foo->content.ptr; |
iterator= foo->content.ptr; |
1521 |
eval(env); if(env->err) return; |
eval(env); if(env->err) return; |
1522 |
iterator= iterator->next; |
iterator= iterator->next; |
1523 |
} |
} |
1524 |
unprotect(env); unprotect(env); |
unprotect(loop); unprotect(foo); |
1525 |
} |
} |
1526 |
|
|
1527 |
/* "to" */ |
/* "to" */ |
1561 |
|
|
1562 |
iterator= env->head; |
iterator= env->head; |
1563 |
pack= new_val(env); |
pack= new_val(env); |
1564 |
protect(env, pack); |
protect(pack); |
1565 |
|
|
1566 |
if(iterator==NULL |
if(iterator==NULL |
1567 |
|| (iterator->item->type==symb |
|| (iterator->item->type==symb |
1591 |
|
|
1592 |
push_val(env, pack); |
push_val(env, pack); |
1593 |
|
|
1594 |
unprotect(env); |
unprotect(pack); |
1595 |
} |
} |
1596 |
|
|
1597 |
/* Read a string */ |
/* Read a string */ |