--- stack/stack.c 2002/03/12 15:13:48 1.106 +++ stack/stack.c 2002/03/16 09:12:39 1.110 @@ -37,12 +37,17 @@ #include /* EX_NOINPUT, EX_USAGE */ #include +/* assert */ +#include + +#ifdef __linux__ /* mtrace, muntrace */ #include /* ioctl */ #include /* KDMKTONE */ #include +#endif /* __linux__ */ #include "stack.h" @@ -118,6 +123,7 @@ stackitem *nitem= malloc(sizeof(stackitem)); nval->content.ptr= NULL; + nval->type= integer; nitem->item= nval; nitem->next= env->gc_ref; @@ -182,7 +188,6 @@ if(env->interactive) printf("."); - env->gc_count= 0; while(env->gc_ref!=NULL) { /* Sweep unused values */ @@ -197,7 +202,32 @@ free(env->gc_ref); /* Remove value */ env->gc_ref= titem; continue; - } + } +#ifdef DEBUG + printf("Kept value (%p)", env->gc_ref->item); + if(env->gc_ref->item->gc.flag.mark) + printf(" (marked)"); + if(env->gc_ref->item->gc.flag.protect) + printf(" (protected)"); + switch(env->gc_ref->item->type){ + case integer: + printf(" integer: %d", env->gc_ref->item->content.i); + break; + case func: + printf(" func: %p", env->gc_ref->item->content.ptr); + break; + case symb: + printf(" symb: %s", env->gc_ref->item->content.sym->id); + break; + case tcons: + printf(" tcons: %p\t%p", env->gc_ref->item->content.c->car, + env->gc_ref->item->content.c->cdr); + break; + default: + printf(" ", (env->gc_ref->item->type)); + } + printf("\n"); +#endif /* DEBUG */ /* Keep values */ env->gc_count += sizeof(value); @@ -217,7 +247,7 @@ env->gc_ref= new_head; if(env->interactive) - printf("done\n"); + printf("done (%d bytes still allocated)\n", env->gc_count); } @@ -255,6 +285,7 @@ value *new_value= new_val(env); new_value->content.c= malloc(sizeof(cons)); + assert(new_value->content.c!=NULL); new_value->type= tcons; CAR(new_value)= val; CDR(new_value)= env->head; @@ -600,11 +631,11 @@ env->err= 3; return; } - protect(val); - toss(env); /* toss the symbol */ + push_val(env, val); /* Return the symbol's bound value */ + swap(env); + if(env->err) return; + toss(env); /* toss the symbol */ if(env->err) return; - push_val(env, val); /* Return its bound value */ - unprotect(val); } /* If the top element is a symbol, determine if it's bound to a @@ -665,7 +696,7 @@ eval(env); if(env->err) return; } - if (CDR(iterator)->type == tcons) + if (CDR(iterator)==NULL || CDR(iterator)->type == tcons) iterator= CDR(iterator); else { printerr("Bad Argument Type"); /* Improper list */ @@ -880,10 +911,14 @@ env->gc_limit= 0; gc_maybe(env); + words(env); + if(env->free_string!=NULL) free(env->free_string); +#ifdef __linux__ muntrace(); +#endif exit(EXIT_SUCCESS); } @@ -904,6 +939,10 @@ for(i= 0; isymbols[i]; while(temp!=NULL) { +#ifdef DEBUG + if (temp->val != NULL && temp->val->gc.flag.protect) + printf("(protected) "); +#endif /* DEBUG */ printf("%s\n", temp->id); temp= temp->next; } @@ -958,7 +997,9 @@ int c; /* getopt option character */ +#ifdef __linux__ mtrace(); +#endif init_env(&myenv); @@ -972,7 +1013,7 @@ break; case '?': fprintf (stderr, - "Unknown option character `\\x%x'.\n", + "Unknown option character '\\x%x'.\n", optopt); return EX_USAGE; default: @@ -989,11 +1030,11 @@ } if(myenv.interactive) { - printf("Stack version $Revision: 1.106 $\n\ + printf("Stack version $Revision: 1.110 $\n\ Copyright (C) 2002 Mats Alritzson and Teddy Hogeborn\n\ -Stack comes with ABSOLUTELY NO WARRANTY; for details type `warranty;'.\n\ +Stack comes with ABSOLUTELY NO WARRANTY; for details type 'warranty;'.\n\ This is free software, and you are welcome to redistribute it\n\ -under certain conditions; type `copying;' for details.\n"); +under certain conditions; type 'copying;' for details.\n"); } while(1) { @@ -1008,9 +1049,10 @@ } myenv.err=0; } - sx_72656164(&myenv); - if (myenv.err==4) { - return EXIT_SUCCESS; /* EOF */ + sx_72656164(&myenv); /* "read" */ + if (myenv.err==4) { /* EOF */ + myenv.err=0; + quit(&myenv); } else if(myenv.head!=NULL && CAR(myenv.head)->type==symb && CAR(myenv.head)->content.sym->id[0] @@ -1256,7 +1298,6 @@ protect(old_value); new_value= new_val(env); - protect(new_value); new_value->type= old_value->type; switch(old_value->type){ @@ -1271,15 +1312,16 @@ strdup((char *)(old_value->content.ptr)); break; case tcons: - new_value= NULL; new_value->content.c= malloc(sizeof(cons)); + assert(new_value->content.c!=NULL); + CAR(new_value)= copy_val(env, CAR(old_value)); /* recurse */ CDR(new_value)= copy_val(env, CDR(old_value)); /* recurse */ break; } - unprotect(old_value); unprotect(new_value); + unprotect(old_value); return new_value; } @@ -1365,7 +1407,30 @@ extern void sx_656c7365(environment *env) { if(env->head==NULL || CDR(env->head)==NULL - || CDR(CDR(env->head))==NULL || CDR(CDR(CDR(env->head)))==NULL) { + || CDR(CDR(env->head))==NULL || CDR(CDR(CDR(env->head)))==NULL + || CDR(CDR(CDR(CDR(env->head))))==NULL) { + printerr("Too Few Arguments"); + env->err= 1; + return; + } + + if(CAR(CDR(env->head))->type!=symb + || strcmp(CAR(CDR(env->head))->content.sym->id, "then")!=0 + || CAR(CDR(CDR(CDR(env->head))))->type!=symb + || strcmp(CAR(CDR(CDR(CDR(env->head))))->content.sym->id, "if")!=0) { + printerr("Bad Argument Type"); + env->err= 2; + return; + } + + swap(env); toss(env); rot(env); toss(env); + ifelse(env); +} + +extern void then(environment *env) +{ + if(env->head==NULL || CDR(env->head)==NULL + || CDR(CDR(env->head))==NULL) { printerr("Too Few Arguments"); env->err= 1; return; @@ -1379,7 +1444,7 @@ } swap(env); toss(env); - ifelse(env); + sx_6966(env); } /* "while" */ @@ -1672,6 +1737,7 @@ return sx_72656164(env); } +#ifdef __linux__ extern void beep(environment *env) { int freq, dur, period, ticks; @@ -1714,6 +1780,7 @@ abort(); } } +#endif /* __linux__ */ /* "wait" */ extern void sx_77616974(environment *env)