--- stack/stack.c 2002/02/05 12:33:21 1.30 +++ stack/stack.c 2002/02/14 05:21:06 1.78 @@ -1,15 +1,15 @@ -/* printf */ +/* printf, sscanf, fgets, fprintf */ #include -/* EXIT_SUCCESS */ +/* exit, EXIT_SUCCESS, malloc, free */ #include /* NULL */ #include /* dlopen, dlsym, dlerror */ #include -/* assert */ -#include +/* strcmp, strcpy, strlen, strcat, strdup */ +#include -#define HASHTBLSIZE 65536 +#define HASHTBLSIZE 2048 /* First, define some types. */ @@ -18,8 +18,6 @@ enum { integer, string, - ref, /* Reference (to an element in the - hash table) */ func, /* Function pointer */ symb, list @@ -50,6 +48,7 @@ typedef struct stackitem_struct { value *item; /* The value on the stack */ + /* (This is never NULL) */ struct stackitem_struct *next; /* Next item */ } stackitem; @@ -58,6 +57,11 @@ typedef struct { stackitem *head; /* Head of the stack */ hashtbl symbols; /* Hash table of all variable bindings */ + int err; /* Error flag */ + int non_eval_flag; + char *in_string; /* Input pending to be read */ + char *free_string; /* Free this string when all input is + read from in_string */ } environment; /* A type for pointers to external functions */ @@ -67,17 +71,68 @@ /* Initialize a newly created environment */ void init_env(environment *env) { - long i; + int i; + env->in_string= NULL; + env->err= 0; + env->non_eval_flag= 0; for(i= 0; isymbols[i]= NULL; } +void printerr(const char* in_string) { + fprintf(stderr, "Err: %s\n", in_string); +} + +/* Throw away a value */ +void free_val(value *val){ + stackitem *item, *temp; + + val->refcount--; /* Decrease the reference count */ + if(val->refcount == 0){ + switch (val->type){ /* and free the contents if necessary */ + case string: + free(val->content.ptr); + break; + case list: /* lists needs to be freed recursively */ + item=val->content.ptr; + while(item != NULL) { /* for all stack items */ + free_val(item->item); /* free the value */ + temp=item->next; /* save next ptr */ + free(item); /* free the stackitem */ + item=temp; /* go to next stackitem */ + } + free(val); /* Free the actual list value */ + break; + case integer: + case func: + case symb: + break; + } + } +} + +/* Discard the top element of the stack. */ +extern void toss(environment *env) +{ + stackitem *temp= env->head; + + if((env->head)==NULL) { + printerr("Too Few Arguments"); + env->err=1; + return; + } + + free_val(env->head->item); /* Free the value */ + env->head= env->head->next; /* Remove the top stack item */ + free(temp); /* Free the old top stack item */ +} + /* Returns a pointer to a pointer to an element in the hash table. */ symbol **hash(hashtbl in_hashtbl, const char *in_string) { - long i= 0; - unsigned long out_hash= 0; + int i= 0; + unsigned int out_hash= 0; char key= '\0'; symbol **position; @@ -102,59 +157,93 @@ } } -/* Generic push function. */ -int push(stackitem** stack_head, stackitem* in_item) -{ - in_item->next= *stack_head; - *stack_head= in_item; - return 1; -} - /* Push a value onto the stack */ -void push_val(stackitem **stack_head, value *val) +void push_val(environment *env, value *val) { stackitem *new_item= malloc(sizeof(stackitem)); new_item->item= val; val->refcount++; - push(stack_head, new_item); + new_item->next= env->head; + env->head= new_item; } /* Push an integer onto the stack. */ -int push_int(stackitem **stack_head, int in_val) +void push_int(environment *env, int in_val) { value *new_value= malloc(sizeof(value)); - stackitem *new_item= malloc(sizeof(stackitem)); - new_item->item= new_value; new_value->content.val= in_val; new_value->type= integer; new_value->refcount=1; - push(stack_head, new_item); - return 1; + push_val(env, new_value); } /* Copy a string onto the stack. */ -int push_cstring(stackitem **stack_head, const char *in_string) +void push_cstring(environment *env, const char *in_string) { value *new_value= malloc(sizeof(value)); - stackitem *new_item= malloc(sizeof(stackitem)); - new_item->item=new_value; new_value->content.ptr= malloc(strlen(in_string)+1); strcpy(new_value->content.ptr, in_string); new_value->type= string; new_value->refcount=1; - push(stack_head, new_item); - return 1; + push_val(env, new_value); +} + +/* Mangle a symbol name to a valid C identifier name */ +char *mangle_str(const char *old_string){ + char validchars[] + ="0123456789abcdef"; + char *new_string, *current; + + new_string=malloc((strlen(old_string)*2)+4); + strcpy(new_string, "sx_"); /* Stack eXternal */ + current=new_string+3; + while(old_string[0] != '\0'){ + current[0]=validchars[(unsigned char)(old_string[0])/16]; + current[1]=validchars[(unsigned char)(old_string[0])%16]; + current+=2; + old_string++; + } + current[0]='\0'; + + return new_string; /* The caller must free() it */ +} + +extern void mangle(environment *env){ + value *new_value; + char *new_string; + + if((env->head)==NULL) { + printerr("Too Few Arguments"); + env->err=1; + return; + } + + if(env->head->item->type!=string) { + printerr("Bad Argument Type"); + env->err=2; + return; + } + + new_string= mangle_str((const char *)(env->head->item->content.ptr)); + + toss(env); + if(env->err) return; + + new_value= malloc(sizeof(value)); + new_value->content.ptr= new_string; + new_value->type= string; + new_value->refcount=1; + + push_val(env, new_value); } /* Push a symbol onto the stack. */ -int push_sym(environment *env, const char *in_string) +void push_sym(environment *env, const char *in_string) { - stackitem *new_item; /* The new stack item */ - /* ...which will contain... */ value *new_value; /* A new symbol value */ /* ...which might point to... */ symbol **new_symbol; /* (if needed) A new actual symbol */ @@ -164,11 +253,10 @@ void *funcptr; /* A function pointer */ static void *handle= NULL; /* Dynamic linker handle */ + const char *dlerr; /* Dynamic linker error */ + char *mangled; /* Mangled function name */ - /* Create a new stack item containing a new value */ - new_item= malloc(sizeof(stackitem)); new_value= malloc(sizeof(value)); - new_item->item=new_value; /* The new value is a symbol */ new_value->type= symb; @@ -196,7 +284,14 @@ handle= dlopen(NULL, RTLD_LAZY); funcptr= dlsym(handle, in_string); /* Get function pointer */ - if(dlerror()==NULL) { /* If a function was found */ + dlerr=dlerror(); + if(dlerr != NULL) { /* If no function was found */ + mangled=mangle_str(in_string); + funcptr= dlsym(handle, mangled); /* try mangling it */ + free(mangled); + dlerr=dlerror(); + } + if(dlerr==NULL) { /* If a function was found */ new_fvalue= malloc(sizeof(value)); /* Create a new value */ new_fvalue->type=func; /* The new value is a function pointer */ new_fvalue->content.ptr=funcptr; /* Store function pointer */ @@ -205,52 +300,7 @@ new_fvalue->refcount= 1; } } - push(&(env->head), new_item); - return 1; -} - -void printerr(const char* in_string) { - fprintf(stderr, "Err: %s\n", in_string); -} - -/* Throw away a value */ -void free_val(value *val){ - stackitem *item, *temp; - - val->refcount--; /* Decrease the reference count */ - if(val->refcount == 0){ - switch (val->type){ /* and free the contents if necessary */ - case string: - free(val->content.ptr); - case list: /* lists needs to be freed recursively */ - item=val->content.ptr; - while(item != NULL) { /* for all stack items */ - free_val(item->item); /* free the value */ - temp=item->next; /* save next ptr */ - free(item); /* free the stackitem */ - item=temp; /* go to next stackitem */ - } - free(val); /* Free the actual list value */ - break; - default: - break; - } - } -} - -/* Discard the top element of the stack. */ -extern void toss(environment *env) -{ - stackitem *temp= env->head; - - if((env->head)==NULL) { - printerr("Stack empty"); - return; - } - - free_val(env->head->item); /* Free the value */ - env->head= env->head->next; /* Remove the top stack item */ - free(temp); /* Free the old top stack item */ + push_val(env, new_value); } /* Print newline. */ @@ -259,32 +309,72 @@ printf("\n"); } -/* Prints the top element of the stack. */ -void print_h(stackitem *stack_head) -{ +/* Gets the type of a value */ +extern void type(environment *env){ + int typenum; - if(stack_head==NULL) { - printerr("Stack empty"); + if((env->head)==NULL) { + printerr("Too Few Arguments"); + env->err=1; return; } + typenum=env->head->item->type; + toss(env); + switch(typenum){ + case integer: + push_sym(env, "integer"); + break; + case string: + push_sym(env, "string"); + break; + case symb: + push_sym(env, "symbol"); + break; + case func: + push_sym(env, "function"); + break; + case list: + push_sym(env, "list"); + break; + } +} +/* Prints the top element of the stack. */ +void print_h(stackitem *stack_head) +{ switch(stack_head->item->type) { case integer: printf("%d", stack_head->item->content.val); break; case string: - printf("\"%s\"", (char*)stack_head->item->content.ptr); + printf("%s", (char*)stack_head->item->content.ptr); break; case symb: - printf("'%s'", ((symbol *)(stack_head->item->content.ptr))->id); + printf("%s", ((symbol *)(stack_head->item->content.ptr))->id); break; - default: - printf("%p", (funcp)(stack_head->item->content.ptr)); + case func: + printf("#", (funcp)(stack_head->item->content.ptr)); + break; + case list: + /* A list is just a stack, so make stack_head point to it */ + stack_head=(stackitem *)(stack_head->item->content.ptr); + printf("[ "); + while(stack_head != NULL) { + print_h(stack_head); + printf(" "); + stack_head=stack_head->next; + } + printf("]"); break; } } extern void print_(environment *env) { + if(env->head==NULL) { + printerr("Too Few Arguments"); + env->err=1; + return; + } print_h(env->head); } @@ -292,6 +382,7 @@ extern void print(environment *env) { print_(env); + if(env->err) return; toss(env); } @@ -305,17 +396,14 @@ nl(); } - - /* Prints the stack. */ extern void printstack(environment *env) { - if(env->head != NULL) { - print_st(env->head, 1); - nl(); - } else { - printerr("Stack empty"); + if(env->head == NULL) { + return; } + print_st(env->head, 1); + nl(); } /* Swap the two top elements on the stack. */ @@ -323,13 +411,9 @@ { stackitem *temp= env->head; - if((env->head)==NULL) { - printerr("Stack empty"); - return; - } - - if(env->head->next==NULL) { - printerr("Not enough arguments"); + if(env->head==NULL || env->head->next==NULL) { + printerr("Too Few Arguments"); + env->err=1; return; } @@ -338,16 +422,50 @@ env->head->next= temp; } -stackitem* copy(stackitem* in_item) +/* Rotate the first three elements on the stack. */ +extern void rot(environment *env) { - stackitem *out_item= malloc(sizeof(stackitem)); - - memcpy(out_item, in_item, sizeof(stackitem)); - out_item->next= NULL; + stackitem *temp= env->head; + + if(env->head==NULL || env->head->next==NULL + || env->head->next->next==NULL) { + printerr("Too Few Arguments"); + env->err=1; + return; + } - return out_item; + env->head= env->head->next->next; + temp->next->next= env->head->next; + env->head->next= temp; } +/* Recall a value from a symbol, if bound */ +extern void rcl(environment *env) +{ + value *val; + + if(env->head == NULL) { + printerr("Too Few Arguments"); + env->err=1; + return; + } + + if(env->head->item->type!=symb) { + printerr("Bad Argument Type"); + env->err=2; + return; + } + + val=((symbol *)(env->head->item->content.ptr))->val; + if(val == NULL){ + printerr("Unbound Variable"); + env->err=3; + return; + } + toss(env); /* toss the symbol */ + if(env->err) return; + push_val(env, val); /* Return its bound value */ +} /* If the top element is a symbol, determine if it's bound to a function value, and if it is, toss the symbol and execute the @@ -355,64 +473,109 @@ extern void eval(environment *env) { funcp in_func; - value* val; + value* temp_val; + stackitem* iterator; + if(env->head==NULL) { - printerr("Stack empty"); + printerr("Too Few Arguments"); + env->err=1; return; } - /* if it's a symbol */ - if(env->head->item->type==symb) { + eval_start: - /* If it's not bound to anything */ - if (((symbol *)(env->head->item->content.ptr))->val == NULL) { - printerr("Unbound variable"); - return; - } - - /* If it contains a function */ - if (((symbol *)(env->head->item->content.ptr))->val->type == func) { - in_func= - (funcp)(((symbol *)(env->head->item->content.ptr))->val->content.ptr); - toss(env); - (*in_func)(env); /* Run the function */ - return; - } else { /* If it's not a function */ - val=((symbol *)(env->head->item->content.ptr))->val; - toss(env); /* toss the symbol */ - push_val(&(env->head), val); /* Return its bound value */ + switch(env->head->item->type) { + /* if it's a symbol */ + case symb: + rcl(env); /* get its contents */ + if(env->err) return; + if(env->head->item->type!=symb){ /* don't recurse symbols */ + goto eval_start; } - } + return; - /* If it's a lone function value, run it */ - if(env->head->item->type==func) { + /* If it's a lone function value, run it */ + case func: in_func= (funcp)(env->head->item->content.ptr); toss(env); - (*in_func)(env); + if(env->err) return; + return (*in_func)(env); + + /* If it's a list */ + case list: + temp_val= env->head->item; + env->head->item->refcount++; + toss(env); + if(env->err) return; + iterator= (stackitem*)temp_val->content.ptr; + while(iterator!=NULL) { + push_val(env, iterator->item); + if(env->head->item->type==symb + && strcmp(";", ((symbol*)(env->head->item->content.ptr))->id)==0) { + toss(env); + if(env->err) return; + if(iterator->next == NULL){ + free_val(temp_val); + goto eval_start; + } + eval(env); + if(env->err) return; + } + iterator= iterator->next; + } + free_val(temp_val); + return; + + default: + return; + } +} + +/* Reverse (flip) a list */ +extern void rev(environment *env){ + stackitem *old_head, *new_head, *item; + + if((env->head)==NULL) { + printerr("Too Few Arguments"); + env->err=1; return; } + if(env->head->item->type!=list) { + printerr("Bad Argument Type"); + env->err=2; + return; + } + + old_head=(stackitem *)(env->head->item->content.ptr); + new_head=NULL; + while(old_head != NULL){ + item=old_head; + old_head=old_head->next; + item->next=new_head; + new_head=item; + } + env->head->item->content.ptr=new_head; } /* Make a list. */ extern void pack(environment *env) { - void* delimiter; stackitem *iterator, *temp; value *pack; - delimiter= env->head->item->content.ptr; /* Get delimiter */ - toss(env); - iterator= env->head; - if(iterator==NULL || iterator->item->content.ptr==delimiter) { + 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->content.ptr!=delimiter) + && (iterator->next->item->type!=symb + || ((symbol*)(iterator->next->item->content.ptr))->id[0]!='[')) iterator= iterator->next; /* Extract list */ @@ -430,86 +593,8 @@ pack->content.ptr= temp; pack->refcount= 1; - temp= malloc(sizeof(stackitem)); - temp->item= pack; - - push(&(env->head), temp); -} - -/* Parse input. */ -int stack_read(environment *env, char *in_line) -{ - char *temp, *rest; - int itemp; - size_t inlength= strlen(in_line)+1; - int convert= 0; - static int non_eval_flag= 0; - - temp= malloc(inlength); - rest= malloc(inlength); - - do { - /* If string */ - if((convert= sscanf(in_line, "\"%[^\"\n\r]\" %[^\n\r]", temp, rest))) { - push_cstring(&(env->head), temp); - break; - } - /* If integer */ - if((convert= sscanf(in_line, "%d %[^\n\r]", &itemp, rest))) { - push_int(&(env->head), itemp); - break; - } - /* Escape ';' with '\' */ - if((convert= sscanf(in_line, "\\%c%[^\n\r]", temp, rest))) { - temp[1]= '\0'; - push_sym(env, temp); - break; - } - /* If symbol */ - if((convert= sscanf(in_line, "%[^][ ;\n\r_]%[^\n\r]", temp, rest))) { - push_sym(env, temp); - break; - } - /* If single char */ - if((convert= sscanf(in_line, "%c%[^\n\r]", temp, rest))) { - if(*temp==';') { - if(!non_eval_flag) { - eval(env); /* Evaluate top element */ - break; - } - - push_sym(env, ";"); - break; - } - - if(*temp==']') { - push_sym(env, "["); - pack(env); - if(non_eval_flag!=0) - non_eval_flag--; - break; - } - - if(*temp=='[') { - push_sym(env, "["); - non_eval_flag++; - break; - } - } - } while(0); - - - free(temp); - - if(convert<2) { - free(rest); - return 0; - } - - stack_read(env, rest); - - free(rest); - return 1; + push_val(env, pack); + rev(env); } /* Relocate elements of the list on the stack. */ @@ -518,11 +603,22 @@ stackitem *temp, *new_head; /* Is top element a list? */ - if(env->head==NULL || env->head->item->type!=list) { - printerr("Stack empty or not a list"); + if(env->head==NULL) { + printerr("Too Few Arguments"); + env->err=1; + return; + } + if(env->head->item->type!=list) { + printerr("Bad Argument Type"); + env->err=2; return; } + rev(env); + + if(env->err) + return; + /* The first list element is the new stack head */ new_head= temp= env->head->item->content.ptr; @@ -546,7 +642,8 @@ int result; if((env->head)==NULL || env->head->next==NULL) { - printerr("Not enough elements to compare"); + printerr("Too Few Arguments"); + env->err=1; return; } @@ -556,7 +653,7 @@ result= (left==right); toss(env); toss(env); - push_int(&(env->head), result); + push_int(env, result); } /* Negates the top element on the stack. */ @@ -564,14 +661,21 @@ { int val; - if((env->head)==NULL || env->head->item->type!=integer) { - printerr("Stack empty or element is not a integer"); + if((env->head)==NULL) { + printerr("Too Few Arguments"); + env->err=1; + return; + } + + if(env->head->item->type!=integer) { + printerr("Bad Argument Type"); + env->err=2; return; } val= env->head->item->content.val; toss(env); - push_int(&(env->head), !val); + push_int(env, !val); } /* Compares the two top elements on the stack and return 0 if they're the @@ -588,9 +692,15 @@ symbol *sym; /* Needs two values on the stack, the top one must be a symbol */ - if(env->head==NULL || env->head->next==NULL - || env->head->item->type!=symb) { - printerr("Define what?"); + if(env->head==NULL || env->head->next==NULL) { + printerr("Too Few Arguments"); + env->err=1; + return; + } + + if(env->head->item->type!=symb) { + printerr("Bad Argument Type"); + env->err=2; return; } @@ -608,9 +718,22 @@ toss(env); toss(env); } +extern void clear(environment *); +void forget_sym(symbol **); + /* Quit stack. */ extern void quit(environment *env) { + long i; + + clear(env); + if (env->err) return; + for(i= 0; isymbols[i]!= NULL) { + forget_sym(&(env->symbols[i])); + env->symbols[i]= NULL; + } + } exit(EXIT_SUCCESS); } @@ -621,19 +744,516 @@ toss(env); } +/* List all defined words */ +extern void words(environment *env) +{ + symbol *temp; + int i; + + for(i= 0; isymbols[i]; + while(temp!=NULL) { + printf("%s\n", temp->id); + temp= temp->next; + } + } +} + +/* Internal forget function */ +void forget_sym(symbol **hash_entry) { + symbol *temp; + + temp= *hash_entry; + *hash_entry= (*hash_entry)->next; + + if(temp->val!=NULL) { + free_val(temp->val); + } + free(temp->id); + free(temp); +} + +/* Forgets a symbol (remove it from the hash table) */ +extern void forget(environment *env) +{ + char* sym_id; + stackitem *stack_head= env->head; + + if(stack_head==NULL) { + printerr("Too Few Arguments"); + env->err=1; + return; + } + + if(stack_head->item->type!=symb) { + printerr("Bad Argument Type"); + env->err=2; + return; + } + + sym_id= ((symbol*)(stack_head->item->content.ptr))->id; + toss(env); + + return forget_sym(hash(env->symbols, sym_id)); +} + +/* Returns the current error number to the stack */ +extern void errn(environment *env){ + push_int(env, env->err); +} + +extern void read(environment*); + int main() { environment myenv; - char in_string[100]; init_env(&myenv); - printf("okidok\n "); + while(1) { + if(myenv.in_string==NULL) + printstack(&myenv); + read(&myenv); + if(myenv.err) { + printf("(error %d) ", myenv.err); + myenv.err=0; + } else if(myenv.head!=NULL + && myenv.head->item->type==symb + && ((symbol*)(myenv.head->item->content.ptr))->id[0]==';') { + toss(&myenv); /* No error check in main */ + eval(&myenv); + } + } + quit(&myenv); + return EXIT_FAILURE; +} + +/* + */ +extern void sx_2b(environment *env) { + int a, b; + size_t len; + char* new_string; + value *a_val, *b_val; + + if((env->head)==NULL || env->head->next==NULL) { + printerr("Too Few Arguments"); + env->err=1; + return; + } - while(fgets(in_string, 100, stdin) != NULL) { - stack_read(&myenv, in_string); - printf("okidok\n "); + if(env->head->item->type==string + && env->head->next->item->type==string) { + a_val= env->head->item; + b_val= env->head->next->item; + a_val->refcount++; + b_val->refcount++; + toss(env); if(env->err) return; + toss(env); if(env->err) return; + len= strlen(a_val->content.ptr)+strlen(b_val->content.ptr)+1; + new_string= malloc(len); + strcpy(new_string, b_val->content.ptr); + strcat(new_string, a_val->content.ptr); + free_val(a_val); free_val(b_val); + push_cstring(env, new_string); + free(new_string); + return; + } + + if(env->head->item->type!=integer + || env->head->next->item->type!=integer) { + printerr("Bad Argument Type"); + env->err=2; + return; } + a=env->head->item->content.val; + toss(env); + if(env->err) return; + if(env->head->item->refcount == 1) + env->head->item->content.val += a; + else { + b=env->head->item->content.val; + toss(env); + if(env->err) return; + push_int(env, a+b); + } +} - exit(EXIT_SUCCESS); +/* - */ +extern void sx_2d(environment *env) { + int a, b; + + if((env->head)==NULL || env->head->next==NULL) { + printerr("Too Few Arguments"); + env->err=1; + return; + } + + if(env->head->item->type!=integer + || env->head->next->item->type!=integer) { + printerr("Bad Argument Type"); + env->err=2; + return; + } + a=env->head->item->content.val; + toss(env); + if(env->err) return; + if(env->head->item->refcount == 1) + env->head->item->content.val -= a; + else { + b=env->head->item->content.val; + toss(env); + if(env->err) return; + push_int(env, b-a); + } +} + +/* > */ +extern void sx_3e(environment *env) { + int a, b; + + if((env->head)==NULL || env->head->next==NULL) { + printerr("Too Few Arguments"); + env->err=1; + return; + } + + if(env->head->item->type!=integer + || env->head->next->item->type!=integer) { + printerr("Bad Argument Type"); + env->err=2; + return; + } + a=env->head->item->content.val; + toss(env); + if(env->err) return; + if(env->head->item->refcount == 1) + env->head->item->content.val = (env->head->item->content.val > a); + else { + b=env->head->item->content.val; + toss(env); + if(env->err) return; + push_int(env, b>a); + } +} + +/* Return copy of a value */ +value *copy_val(value *old_value){ + stackitem *old_item, *new_item, *prev_item; + + value *new_value=malloc(sizeof(value)); + + new_value->type=old_value->type; + new_value->refcount=0; /* This is increased if/when this + value is referenced somewhere, like + in a stack item or a variable */ + switch(old_value->type){ + case integer: + new_value->content.val=old_value->content.val; + break; + case string: + (char *)(new_value->content.ptr) + = strdup((char *)(old_value->content.ptr)); + break; + case func: + case symb: + new_value->content.ptr=old_value->content.ptr; + break; + case list: + new_value->content.ptr=NULL; + + prev_item=NULL; + old_item=(stackitem *)(old_value->content.ptr); + + while(old_item != NULL) { /* While list is not empty */ + new_item= malloc(sizeof(stackitem)); + new_item->item=copy_val(old_item->item); /* recurse */ + new_item->next=NULL; + if(prev_item != NULL) /* If this wasn't the first item */ + prev_item->next=new_item; /* point the previous item to the + new item */ + else + new_value->content.ptr=new_item; + old_item=old_item->next; + prev_item=new_item; + } + break; + } + return new_value; +} + +/* duplicates an item on the stack */ +extern void dup(environment *env) { + if((env->head)==NULL) { + printerr("Too Few Arguments"); + env->err=1; + return; + } + push_val(env, copy_val(env->head->item)); +} + +/* "if", If-Then */ +extern void sx_6966(environment *env) { + + int truth; + + if((env->head)==NULL || env->head->next==NULL) { + printerr("Too Few Arguments"); + env->err=1; + return; + } + + if(env->head->next->item->type != integer) { + printerr("Bad Argument Type"); + env->err=2; + return; + } + + swap(env); + if(env->err) return; + + truth=env->head->item->content.val; + + toss(env); + if(env->err) return; + + if(truth) + eval(env); + else + toss(env); +} + +/* If-Then-Else */ +extern void ifelse(environment *env) { + + int truth; + + if((env->head)==NULL || env->head->next==NULL + || env->head->next->next==NULL) { + printerr("Too Few Arguments"); + env->err=1; + return; + } + + if(env->head->next->next->item->type != integer) { + printerr("Bad Argument Type"); + env->err=2; + return; + } + + rot(env); + if(env->err) return; + + truth=env->head->item->content.val; + + toss(env); + if(env->err) return; + + if(!truth) + swap(env); + if(env->err) return; + + toss(env); + if(env->err) return; + + eval(env); +} + +/* while */ +extern void sx_7768696c65(environment *env) { + + int truth; + value *loop, *test; + + if((env->head)==NULL || env->head->next==NULL) { + printerr("Too Few Arguments"); + env->err=1; + return; + } + + loop= env->head->item; + loop->refcount++; + toss(env); if(env->err) return; + + test= env->head->item; + test->refcount++; + toss(env); if(env->err) return; + + do { + push_val(env, test); + eval(env); + + if(env->head->item->type != integer) { + printerr("Bad Argument Type"); + env->err=2; + return; + } + + truth= env->head->item->content.val; + toss(env); if(env->err) return; + + if(truth) { + push_val(env, loop); + eval(env); + } else { + toss(env); + } + + } while(truth); + + free_val(test); + free_val(loop); +} + +/* For-loop */ +extern void sx_666f72(environment *env) { + + value *loop, *foo; + stackitem *iterator; + + if((env->head)==NULL || env->head->next==NULL) { + printerr("Too Few Arguments"); + env->err=1; + return; + } + + if(env->head->next->item->type != list) { + printerr("Bad Argument Type"); + env->err=2; + return; + } + + loop= env->head->item; + loop->refcount++; + toss(env); if(env->err) return; + + foo= env->head->item; + foo->refcount++; + toss(env); if(env->err) return; + + iterator= foo->content.ptr; + + while(iterator!=NULL) { + push_val(env, iterator->item); + push_val(env, loop); + eval(env); if(env->err) return; + iterator= iterator->next; + } + + free_val(loop); + free_val(foo); +} + +/* 'to' */ +extern void to(environment *env) { + int i, start, ending; + stackitem *temp_head; + value *temp_val; + + if((env->head)==NULL || env->head->next==NULL) { + printerr("Too Few Arguments"); + env->err=1; + return; + } + + if(env->head->item->type!=integer + || env->head->next->item->type!=integer) { + printerr("Bad Argument Type"); + env->err=2; + return; + } + + ending= env->head->item->content.val; + toss(env); if(env->err) return; + start= env->head->item->content.val; + toss(env); if(env->err) return; + + temp_head= env->head; + env->head= NULL; + + if(ending>=start) { + for(i= ending; i>=start; i--) + push_int(env, i); + } else { + for(i= ending; i<=start; i++) + push_int(env, i); + } + + temp_val= malloc(sizeof(value)); + temp_val->content.ptr= env->head; + temp_val->refcount= 1; + temp_val->type= list; + env->head= temp_head; + push_val(env, temp_val); +} + +/* Read a string */ +extern void readline(environment *env) { + char in_string[101]; + + fgets(in_string, 100, stdin); + push_cstring(env, in_string); +} + +/* Read a value and place on stack */ +extern void read(environment *env) { + const char symbform[]= "%[a-zA-Z0-9!$%*+./:<=>?@^_~-]%n"; + const char strform[]= "\"%[^\"]\"%n"; + const char intform[]= "%i%n"; + const char blankform[]= "%*[ \t]%n"; + const char ebrackform[]= "%*1[]]%n"; + const char semicform[]= "%*1[;]%n"; + const char bbrackform[]= "%*1[[]%n"; + + int itemp, readlength= -1; + static int depth= 0; + char *rest, *match; + size_t inlength; + + if(env->in_string==NULL) { + readline(env); if(env->err) return; + + env->in_string= malloc(strlen(env->head->item->content.ptr)+1); + env->free_string= env->in_string; /* Save the original pointer */ + strcpy(env->in_string, env->head->item->content.ptr); + toss(env); if(env->err) return; + } + + inlength= strlen(env->in_string)+1; + match= malloc(inlength); + rest= malloc(inlength); + + if(sscanf(env->in_string, blankform, &readlength)!=EOF + && readlength != -1) { + ; + } else if(sscanf(env->in_string, intform, &itemp, &readlength) != EOF + && readlength != -1) { + push_int(env, itemp); + } else if(sscanf(env->in_string, strform, match, &readlength) != EOF + && readlength != -1) { + push_cstring(env, match); + } else if(sscanf(env->in_string, symbform, match, &readlength) != EOF + && readlength != -1) { + push_sym(env, match); + } else if(sscanf(env->in_string, ebrackform, &readlength) != EOF + && readlength != -1) { + pack(env); if(env->err) return; + if(depth != 0) depth--; + } else if(sscanf(env->in_string, semicform, &readlength) != EOF + && readlength != -1) { + push_sym(env, ";"); + } else if(sscanf(env->in_string, bbrackform, &readlength) != EOF + && readlength != -1) { + push_sym(env, "["); + depth++; + } else { + free(env->free_string); + env->in_string = env->free_string = NULL; + free(match); + } + if ( env->in_string != NULL) { + env->in_string += readlength; + } + + if(depth) + return read(env); }