--- stack/stack.c 2002/03/12 21:05:11 1.107 +++ stack/stack.c 2002/03/14 10:39:11 1.109 @@ -37,6 +37,8 @@ #include /* EX_NOINPUT, EX_USAGE */ #include +/* assert */ +#include #ifdef __linux__ /* mtrace, muntrace */ @@ -121,6 +123,7 @@ stackitem *nitem= malloc(sizeof(stackitem)); nval->content.ptr= NULL; + nval->type= integer; nitem->item= nval; nitem->next= env->gc_ref; @@ -258,6 +261,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; @@ -996,7 +1000,7 @@ } if(myenv.interactive) { - printf("Stack version $Revision: 1.107 $\n\ + printf("Stack version $Revision: 1.109 $\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\ @@ -1263,7 +1267,6 @@ protect(old_value); new_value= new_val(env); - protect(new_value); new_value->type= old_value->type; switch(old_value->type){ @@ -1278,15 +1281,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; } @@ -1372,7 +1376,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; @@ -1386,7 +1413,7 @@ } swap(env); toss(env); - ifelse(env); + sx_6966(env); } /* "while" */