--- stack/stack.c 2002/03/09 09:58:31 1.94 +++ stack/stack.c 2002/03/10 07:55:13 1.96 @@ -48,7 +48,7 @@ { int i; - env->gc_limit= 20; + env->gc_limit= 200; env->gc_count= 0; env->gc_ref= NULL; env->gc_protect= NULL; @@ -63,7 +63,8 @@ env->interactive= 1; } -void printerr(const char* in_string) { +void printerr(const char* in_string) +{ fprintf(stderr, "Err: %s\n", in_string); } @@ -81,7 +82,7 @@ env->head= env->head->next; /* Remove the top stack item */ free(temp); /* Free the old top stack item */ - gc_init(env); + env->gc_limit--; } /* Returns a pointer to a pointer to an element in the hash table. */ @@ -113,7 +114,9 @@ } } -value* new_val(environment *env) { +/* Create new value */ +value* new_val(environment *env) +{ value *nval= malloc(sizeof(value)); stackitem *nitem= malloc(sizeof(stackitem)); @@ -125,14 +128,13 @@ env->gc_count++; - protect(env, nval); - gc_init(env); - unprotect(env); - return nval; } -void gc_mark(value *val) { +/* Mark values recursively. + Marked values are not collected by the GC. */ +inline void gc_mark(value *val) +{ stackitem *iterator; if(val==NULL || val->gc_garb==0) @@ -150,14 +152,21 @@ } } -extern void gc_init(environment *env) { +inline void gc_maybe(environment *env) +{ + if(env->gc_count < env->gc_limit) + return; + else + return gc_init(env); +} + +/* Start GC */ +extern void gc_init(environment *env) +{ stackitem *new_head= NULL, *titem, *iterator; symbol *tsymb; int i; - if(env->gc_count < env->gc_limit) - return; - /* Garb by default */ iterator= env->gc_ref; while(iterator!=NULL) { @@ -172,7 +181,7 @@ iterator= iterator->next; } - /* Mark values in stack */ + /* Mark values on stack */ iterator= env->head; while(iterator!=NULL) { gc_mark(iterator->item); @@ -190,13 +199,11 @@ env->gc_count= 0; - /* Sweep */ - while(env->gc_ref!=NULL) { + while(env->gc_ref!=NULL) { /* Sweep unused values */ if(env->gc_ref->item->gc_garb) { - /* Remove content */ - switch(env->gc_ref->item->type) { + switch(env->gc_ref->item->type) { /* Remove content */ case string: free(env->gc_ref->item->content.ptr); break; @@ -214,7 +221,7 @@ titem= env->gc_ref->next; free(env->gc_ref); /* Remove value */ env->gc_ref= titem; - } else { /* Save */ + } else { /* Keep values */ titem= env->gc_ref->next; env->gc_ref->next= new_head; new_head= env->gc_ref; @@ -227,6 +234,7 @@ env->gc_ref= new_head; } +/* Protect values from GC */ void protect(environment *env, value *val) { stackitem *new_item= malloc(sizeof(stackitem)); @@ -235,6 +243,7 @@ env->gc_protect= new_item; } +/* Unprotect values from GC */ void unprotect(environment *env) { stackitem *temp= env->gc_protect; @@ -251,7 +260,7 @@ env->head= new_item; } -/* Push an integer onto the stack. */ +/* Push an integer onto the stack */ void push_int(environment *env, int in_val) { value *new_value= new_val(env); @@ -262,6 +271,7 @@ push_val(env, new_value); } +/* Push a floating point number onto the stack */ void push_float(environment *env, float in_val) { value *new_value= new_val(env); @@ -285,7 +295,8 @@ } /* Mangle a symbol name to a valid C identifier name */ -char *mangle_str(const char *old_string){ +char *mangle_str(const char *old_string) +{ char validchars[]= "0123456789abcdef"; char *new_string, *current; @@ -303,7 +314,8 @@ return new_string; /* The caller must free() it */ } -extern void mangle(environment *env){ +extern void mangle(environment *env) +{ char *new_string; if((env->head)==NULL) { @@ -372,19 +384,23 @@ mangled= mangle_str(in_string); /* mangle the name */ funcptr= dlsym(handle, mangled); /* and try to find it */ - free(mangled); + dlerr= dlerror(); if(dlerr != NULL) { /* If no function was found */ funcptr= dlsym(handle, in_string); /* Get function pointer */ dlerr= dlerror(); } + if(dlerr==NULL) { /* If a function was found */ new_fvalue->type= func; /* The new value is a function pointer */ new_fvalue->content.ptr= funcptr; /* Store function pointer */ (*new_symbol)->val= new_fvalue; /* Bind the symbol to the new function value */ } + + free(mangled); } + push_val(env, new_value); unprotect(env); unprotect(env); } @@ -396,7 +412,8 @@ } /* Gets the type of a value */ -extern void type(environment *env){ +extern void type(environment *env) +{ int typenum; if((env->head)==NULL) { @@ -464,7 +481,8 @@ } } -extern void print_(environment *env) { +extern void print_(environment *env) +{ if(env->head==NULL) { printerr("Too Few Arguments"); env->err=1; @@ -482,7 +500,8 @@ toss(env); } -extern void princ_(environment *env) { +extern void princ_(environment *env) +{ if(env->head==NULL) { printerr("Too Few Arguments"); env->err=1; @@ -516,6 +535,7 @@ printf("Stack Empty\n"); return; } + print_st(env->head, 1); } @@ -593,6 +613,8 @@ eval_start: + gc_maybe(env); + if(env->head==NULL) { printerr("Too Few Arguments"); env->err=1; @@ -649,7 +671,8 @@ } /* Reverse (flip) a list */ -extern void rev(environment *env){ +extern void rev(environment *env) +{ stackitem *old_head, *new_head, *item; if((env->head)==NULL) { @@ -835,7 +858,7 @@ /* Quit stack. */ extern void quit(environment *env) { - long i; + int i; clear(env); @@ -848,7 +871,7 @@ } env->gc_limit= 0; - gc_init(env); + gc_maybe(env); if(env->free_string!=NULL) free(env->free_string); @@ -881,7 +904,8 @@ } /* Internal forget function */ -void forget_sym(symbol **hash_entry) { +void forget_sym(symbol **hash_entry) +{ symbol *temp; temp= *hash_entry; @@ -916,7 +940,8 @@ } /* Returns the current error number to the stack */ -extern void errn(environment *env){ +extern void errn(environment *env) +{ push_int(env, env->err); } @@ -957,7 +982,7 @@ } if(myenv.interactive) { - printf("Stack version $Revision: 1.94 $\n\ + printf("Stack version $Revision: 1.96 $\n\ Copyright (C) 2002 Mats Alritzson and Teddy Hogeborn\n\ Stack comes with ABSOLUTELY NO WARRANTY; for details type `warranty;'.\n\ This is free software, and you are welcome to redistribute it\n\ @@ -985,14 +1010,15 @@ toss(&myenv); /* No error check in main */ eval(&myenv); } - gc_init(&myenv); + gc_maybe(&myenv); } quit(&myenv); return EXIT_FAILURE; } /* "+" */ -extern void sx_2b(environment *env) { +extern void sx_2b(environment *env) +{ int a, b; float fa, fb; size_t len; @@ -1072,7 +1098,8 @@ } /* "-" */ -extern void sx_2d(environment *env) { +extern void sx_2d(environment *env) +{ int a, b; float fa, fb; @@ -1131,7 +1158,8 @@ } /* ">" */ -extern void sx_3e(environment *env) { +extern void sx_3e(environment *env) +{ int a, b; float fa, fb; @@ -1190,25 +1218,29 @@ } /* "<" */ -extern void sx_3c(environment *env) { +extern void sx_3c(environment *env) +{ swap(env); if(env->err) return; sx_3e(env); } /* "<=" */ -extern void sx_3c3d(environment *env) { +extern void sx_3c3d(environment *env) +{ sx_3e(env); if(env->err) return; not(env); } /* ">=" */ -extern void sx_3e3d(environment *env) { +extern void sx_3e3d(environment *env) +{ sx_3c(env); if(env->err) return; not(env); } /* Return copy of a value */ -value *copy_val(environment *env, value *old_value){ +value *copy_val(environment *env, value *old_value) +{ stackitem *old_item, *new_item, *prev_item; value *new_value; @@ -1255,7 +1287,8 @@ } /* "dup"; duplicates an item on the stack */ -extern void sx_647570(environment *env) { +extern void sx_647570(environment *env) +{ if((env->head)==NULL) { printerr("Too Few Arguments"); env->err= 1; @@ -1265,8 +1298,8 @@ } /* "if", If-Then */ -extern void sx_6966(environment *env) { - +extern void sx_6966(environment *env) +{ int truth; if((env->head)==NULL || env->head->next==NULL) { @@ -1296,8 +1329,8 @@ } /* If-Then-Else */ -extern void ifelse(environment *env) { - +extern void ifelse(environment *env) +{ int truth; if((env->head)==NULL || env->head->next==NULL @@ -1332,8 +1365,8 @@ } /* "while" */ -extern void sx_7768696c65(environment *env) { - +extern void sx_7768696c65(environment *env) +{ int truth; value *loop, *test; @@ -1378,7 +1411,8 @@ /* "for"; for-loop */ -extern void sx_666f72(environment *env) { +extern void sx_666f72(environment *env) +{ value *loop; int foo1, foo2; @@ -1425,8 +1459,8 @@ } /* Variant of for-loop */ -extern void foreach(environment *env) { - +extern void foreach(environment *env) +{ value *loop, *foo; stackitem *iterator; @@ -1462,11 +1496,12 @@ } /* "to" */ -extern void to(environment *env) { - int i, start, ending; - stackitem *temp_head; - value *temp_val; - +extern void to(environment *env) +{ + int ending, start, i; + stackitem *iterator, *temp; + value *pack; + if((env->head)==NULL || env->head->next==NULL) { printerr("Too Few Arguments"); env->err=1; @@ -1485,8 +1520,7 @@ start= env->head->item->content.i; toss(env); if(env->err) return; - temp_head= env->head; - env->head= NULL; + push_sym(env, "["); if(ending>=start) { for(i= ending; i>=start; i--) @@ -1496,19 +1530,44 @@ push_int(env, i); } - temp_val= new_val(env); - protect(env, temp_val); + iterator= env->head; + pack= new_val(env); + protect(env, pack); - temp_val->content.ptr= env->head; - temp_val->type= list; - env->head= temp_head; - push_val(env, temp_val); + if(iterator==NULL + || (iterator->item->type==symb + && ((symbol*)(iterator->item->content.ptr))->id[0]=='[')) { + temp= NULL; + toss(env); + } else { + /* Search for first delimiter */ + while(iterator->next!=NULL + && (iterator->next->item->type!=symb + || ((symbol*)(iterator->next->item->content.ptr))->id[0]!='[')) + iterator= iterator->next; + + /* Extract list */ + temp= env->head; + env->head= iterator->next; + iterator->next= NULL; + + pack->type= list; + pack->content.ptr= temp; + + if(env->head!=NULL) + toss(env); + } + + /* Push list */ + + push_val(env, pack); unprotect(env); } /* Read a string */ -extern void readline(environment *env) { +extern void readline(environment *env) +{ char in_string[101]; if(fgets(in_string, 100, env->inputstream)==NULL) @@ -1518,7 +1577,8 @@ } /* "read"; Read a value and place on stack */ -extern void sx_72656164(environment *env) { +extern void sx_72656164(environment *env) +{ const char symbform[]= "%[a-zA-Z0-9!$%*+./:<=>?@^_~-]%n"; const char strform[]= "\"%[^\"]\"%n"; const char intform[]= "%i%n"; @@ -1597,8 +1657,8 @@ return sx_72656164(env); } -extern void beep(environment *env) { - +extern void beep(environment *env) +{ int freq, dur, period, ticks; if((env->head)==NULL || env->head->next==NULL) { @@ -1638,11 +1698,11 @@ default: abort(); } -}; +} /* "wait" */ -extern void sx_77616974(environment *env) { - +extern void sx_77616974(environment *env) +{ int dur; if((env->head)==NULL) { @@ -1661,9 +1721,10 @@ toss(env); usleep(dur); -}; +} -extern void copying(environment *env){ +extern void copying(environment *env) +{ printf("GNU GENERAL PUBLIC LICENSE\n\ Version 2, June 1991\n\ \n\ @@ -1922,7 +1983,8 @@ of promoting the sharing and reuse of software generally.\n"); } -extern void warranty(environment *env){ +extern void warranty(environment *env) +{ printf(" NO WARRANTY\n\ \n\ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY\n\