--- stack/stack.c 2002/03/10 10:06:36 1.99 +++ stack/stack.c 2002/03/17 12:49:27 1.116 @@ -1,3 +1,4 @@ +/* -*- coding: utf-8; -*- */ /* stack - an interactive interpreter for a stack-based language Copyright (C) 2002 Mats Alritzson and Teddy Hogeborn @@ -20,6 +21,9 @@ Teddy Hogeborn */ +#define CAR(X) (X->content.c->car) +#define CDR(X) (X->content.c->cdr) + /* printf, sscanf, fgets, fprintf, fopen, perror */ #include /* exit, EXIT_SUCCESS, malloc, free */ @@ -34,12 +38,17 @@ #include /* EX_NOINPUT, EX_USAGE */ #include +/* assert */ +#include + +#ifdef __linux__ /* mtrace, muntrace */ #include /* ioctl */ #include /* KDMKTONE */ #include +#endif /* __linux__ */ #include "stack.h" @@ -48,11 +57,12 @@ { int i; - env->gc_limit= 200; + env->gc_limit= 400000; env->gc_count= 0; env->gc_ref= NULL; - env->head= NULL; + env->head= new_val(env); + env->head->type= empty; for(i= 0; isymbols[i]= NULL; env->err= 0; @@ -70,18 +80,13 @@ /* Discard the top element of the stack. */ extern void toss(environment *env) { - stackitem *temp= env->head; - - if((env->head)==NULL) { + if(env->head->type==empty) { printerr("Too Few Arguments"); env->err= 1; return; } - env->head= env->head->next; /* Remove the top stack item */ - free(temp); /* Free the old top stack item */ - - env->gc_limit--; + env->head= CDR(env->head); /* Remove the top stack item */ } /* Returns a pointer to a pointer to an element in the hash table. */ @@ -120,12 +125,14 @@ stackitem *nitem= malloc(sizeof(stackitem)); nval->content.ptr= NULL; + nval->type= integer; nitem->item= nval; nitem->next= env->gc_ref; + env->gc_ref= nitem; - env->gc_count++; + env->gc_count += sizeof(value); nval->gc.flag.mark= 0; nval->gc.flag.protect= 0; @@ -136,20 +143,14 @@ Marked values are not collected by the GC. */ inline void gc_mark(value *val) { - stackitem *iterator; - - if(val->gc.flag.mark) + if(val==NULL || val->gc.flag.mark) return; val->gc.flag.mark= 1; - if(val->type==list) { - iterator= val->content.ptr; - - while(iterator!=NULL) { - gc_mark(iterator->item); - iterator= iterator->next; - } + if(val->type==tcons) { + gc_mark(CAR(val)); + gc_mark(CDR(val)); } } @@ -164,26 +165,29 @@ /* Start GC */ extern void gc_init(environment *env) { - stackitem *new_head= NULL, *titem, *iterator; + stackitem *new_head= NULL, *titem; symbol *tsymb; int i; + if(env->interactive) + printf("Garbage collecting."); + /* Mark values on stack */ - iterator= env->head; - while(iterator!=NULL) { - gc_mark(iterator->item); - iterator= iterator->next; - } + gc_mark(env->head); + + if(env->interactive) + printf("."); + /* Mark values in hashtable */ - for(i= 0; isymbols[i]; - while(tsymb!=NULL) { + for(i= 0; isymbols[i]; tsymb!=NULL; tsymb= tsymb->next) if (tsymb->val != NULL) gc_mark(tsymb->val); - tsymb= tsymb->next; - } - } + + + if(env->interactive) + printf("."); env->gc_count= 0; @@ -191,85 +195,116 @@ if(!(env->gc_ref->item->gc.no_gc)){ /* neither mark nor protect */ - switch(env->gc_ref->item->type) { /* Remove content */ + /* Remove content */ + switch(env->gc_ref->item->type){ case string: free(env->gc_ref->item->content.ptr); break; - case list: - while(env->gc_ref->item->content.ptr!=NULL) { - titem= env->gc_ref->item->content.ptr; - env->gc_ref->item->content.ptr= titem->next; - free(titem); - } - default: + case tcons: + free(env->gc_ref->item->content.c); + break; + case empty: + case integer: + case tfloat: + case func: + case symb: + /* Symbol strings are freed when walking the hash table */ } + free(env->gc_ref->item); /* Remove from gc_ref */ titem= env->gc_ref->next; 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); + if(env->gc_ref->item->type==string) + env->gc_count += strlen(env->gc_ref->item->content.ptr)+1; - /* Keep values */ titem= env->gc_ref->next; env->gc_ref->next= new_head; new_head= env->gc_ref; new_head->item->gc.flag.mark= 0; env->gc_ref= titem; - env->gc_count++; } - env->gc_limit= env->gc_count*2; + if (env->gc_limit < env->gc_count*2) + env->gc_limit= env->gc_count*2; + env->gc_ref= new_head; + + if(env->interactive) + printf("done (%d bytes still allocated)\n", env->gc_count); + } /* Protect values from GC */ void protect(value *val) { - stackitem *iterator; - - if(val->gc.flag.protect) + if(val==NULL || val->gc.flag.protect) return; val->gc.flag.protect= 1; - if(val->type==list) { - iterator= val->content.ptr; - - while(iterator!=NULL) { - protect(iterator->item); - iterator= iterator->next; - } + if(val->type==tcons) { + protect(CAR(val)); + protect(CDR(val)); } } /* Unprotect values from GC */ void unprotect(value *val) { - stackitem *iterator; - - if(!(val->gc.flag.protect)) + if(val==NULL || !(val->gc.flag.protect)) return; val->gc.flag.protect= 0; - if(val->type==list) { - iterator= val->content.ptr; - - while(iterator!=NULL) { - unprotect(iterator->item); - iterator= iterator->next; - } + if(val->type==tcons) { + unprotect(CAR(val)); + unprotect(CDR(val)); } } /* Push a value onto the stack */ void push_val(environment *env, value *val) { - stackitem *new_item= malloc(sizeof(stackitem)); - new_item->item= val; - new_item->next= env->head; - env->head= new_item; + value *new_value= new_val(env); + + new_value->content.c= malloc(sizeof(pair)); + assert(new_value->content.c!=NULL); + env->gc_count += sizeof(pair); + new_value->type= tcons; + CAR(new_value)= val; + CDR(new_value)= env->head; + env->head= new_value; } /* Push an integer onto the stack */ @@ -298,8 +333,10 @@ void push_cstring(environment *env, const char *in_string) { value *new_value= new_val(env); + int length= strlen(in_string)+1; - new_value->content.ptr= malloc(strlen(in_string)+1); + new_value->content.ptr= malloc(length); + env->gc_count += length; strcpy(new_value->content.ptr, in_string); new_value->type= string; @@ -330,19 +367,20 @@ { char *new_string; - if((env->head)==NULL) { + if(env->head->type==empty) { printerr("Too Few Arguments"); env->err= 1; return; } - if(env->head->item->type!=string) { + if(CAR(env->head)->type!=string) { printerr("Bad Argument Type"); env->err= 2; return; } - new_string= mangle_str((const char *)(env->head->item->content.ptr)); + new_string= + mangle_str((const char *)(CAR(env->head)->content.ptr)); toss(env); if(env->err) return; @@ -426,16 +464,16 @@ /* Gets the type of a value */ extern void type(environment *env) { - int typenum; - - if((env->head)==NULL) { + if(env->head->type==empty) { printerr("Too Few Arguments"); - env->err=1; + env->err= 1; return; } - typenum=env->head->item->type; - toss(env); - switch(typenum){ + + switch(CAR(env->head)->type){ + case empty: + push_sym(env, "empty"); + break; case integer: push_sym(env, "integer"); break; @@ -451,56 +489,69 @@ case func: push_sym(env, "function"); break; - case list: - push_sym(env, "list"); + case tcons: + push_sym(env, "pair"); break; } + swap(env); + if (env->err) return; + toss(env); } -/* Prints the top element of the stack. */ -void print_h(stackitem *stack_head, int noquote) +/* Print a value */ +void print_val(value *val, int noquote) { - switch(stack_head->item->type) { + switch(val->type) { + case empty: + printf("[]"); + break; case integer: - printf("%d", stack_head->item->content.i); + printf("%d", val->content.i); break; case tfloat: - printf("%f", stack_head->item->content.f); + printf("%f", val->content.f); break; case string: if(noquote) - printf("%s", (char*)stack_head->item->content.ptr); + printf("%s", (char*)(val->content.ptr)); else - printf("\"%s\"", (char*)stack_head->item->content.ptr); + printf("\"%s\"", (char*)(val->content.ptr)); break; case symb: - printf("%s", ((symbol *)(stack_head->item->content.ptr))->id); + printf("%s", val->content.sym->id); break; case func: - printf("#", (funcp)(stack_head->item->content.ptr)); + printf("#", (funcp)(val->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); + case tcons: printf("[ "); - while(stack_head != NULL) { - print_h(stack_head, noquote); - printf(" "); - stack_head=stack_head->next; - } - printf("]"); + do { + print_val(CAR(val), noquote); + val= CDR(val); + switch(val->type){ + case empty: + break; + case tcons: + printf(" "); + break; + default: + printf(" . "); /* Improper list */ + print_val(val, noquote); + } + } while(val->type == tcons); + printf(" ]"); break; } } extern void print_(environment *env) { - if(env->head==NULL) { + if(env->head->type==empty) { printerr("Too Few Arguments"); - env->err=1; + env->err= 1; return; } - print_h(env->head, 0); + print_val(CAR(env->head), 0); nl(); } @@ -514,12 +565,12 @@ extern void princ_(environment *env) { - if(env->head==NULL) { + if(env->head->type==empty) { printerr("Too Few Arguments"); - env->err=1; + env->err= 1; return; } - print_h(env->head, 1); + print_val(CAR(env->head), 1); } /* Prints the top element of the stack and then discards it. */ @@ -531,19 +582,19 @@ } /* Only to be called by function printstack. */ -void print_st(stackitem *stack_head, long counter) +void print_st(value *stack_head, long counter) { - if(stack_head->next != NULL) - print_st(stack_head->next, counter+1); + if(CDR(stack_head)->type != empty) + print_st(CDR(stack_head), counter+1); printf("%ld: ", counter); - print_h(stack_head, 0); + print_val(CAR(stack_head), 0); nl(); } /* Prints the stack. */ extern void printstack(environment *env) { - if(env->head == NULL) { + if(env->head->type == empty) { printf("Stack Empty\n"); return; } @@ -554,34 +605,34 @@ /* Swap the two top elements on the stack. */ extern void swap(environment *env) { - stackitem *temp= env->head; + value *temp= env->head; - if(env->head==NULL || env->head->next==NULL) { + if(env->head->type == empty || CDR(env->head)->type == empty) { printerr("Too Few Arguments"); env->err=1; return; } - env->head= env->head->next; - temp->next= env->head->next; - env->head->next= temp; + env->head= CDR(env->head); + CDR(temp)= CDR(env->head); + CDR(env->head)= temp; } /* Rotate the first three elements on the stack. */ extern void rot(environment *env) { - stackitem *temp= env->head; + value *temp= env->head; - if(env->head==NULL || env->head->next==NULL - || env->head->next->next==NULL) { + if(env->head->type == empty || CDR(env->head)->type == empty + || CDR(CDR(env->head))->type == empty) { printerr("Too Few Arguments"); - env->err=1; + env->err= 1; return; } - - env->head= env->head->next->next; - temp->next->next= env->head->next; - env->head->next= temp; + + env->head= CDR(CDR(env->head)); + CDR(CDR(temp))= CDR(env->head); + CDR(env->head)= temp; } /* Recall a value from a symbol, if bound */ @@ -589,29 +640,29 @@ { value *val; - if(env->head == NULL) { + if(env->head->type==empty) { printerr("Too Few Arguments"); - env->err=1; + env->err= 1; return; } - if(env->head->item->type!=symb) { + if(CAR(env->head)->type!=symb) { printerr("Bad Argument Type"); - env->err=2; + env->err= 2; return; } - val=((symbol *)(env->head->item->content.ptr))->val; + val= CAR(env->head)->content.sym->val; if(val == NULL){ printerr("Unbound Variable"); - env->err=3; + 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 @@ -621,63 +672,72 @@ { funcp in_func; value* temp_val; - stackitem* iterator; + value* iterator; eval_start: gc_maybe(env); - if(env->head==NULL) { + if(env->head->type==empty) { printerr("Too Few Arguments"); - env->err=1; + env->err= 1; return; } - switch(env->head->item->type) { + switch(CAR(env->head)->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 */ + if(CAR(env->head)->type!=symb){ /* don't recurse symbols */ goto eval_start; } return; /* If it's a lone function value, run it */ case func: - in_func= (funcp)(env->head->item->content.ptr); + in_func= (funcp)(CAR(env->head)->content.ptr); toss(env); if(env->err) return; return in_func(env); /* If it's a list */ - case list: - temp_val= env->head->item; + case tcons: + temp_val= CAR(env->head); protect(temp_val); toss(env); if(env->err) return; - iterator= (stackitem*)temp_val->content.ptr; + iterator= temp_val; - while(iterator!=NULL) { - push_val(env, iterator->item); + while(iterator->type != empty) { + push_val(env, CAR(iterator)); - if(env->head->item->type==symb - && strcmp(";", ((symbol*)(env->head->item->content.ptr))->id)==0) { + if(CAR(env->head)->type==symb + && CAR(env->head)->content.sym->id[0]==';') { toss(env); if(env->err) return; - if(iterator->next == NULL){ + if(CDR(iterator)->type == empty){ goto eval_start; } eval(env); if(env->err) return; } - iterator= iterator->next; + if (CDR(iterator)->type == empty || CDR(iterator)->type == tcons) + iterator= CDR(iterator); + else { + printerr("Bad Argument Type"); /* Improper list */ + env->err= 2; + return; + } } unprotect(temp_val); return; - default: + case empty: + case integer: + case tfloat: + case string: return; } } @@ -685,85 +745,84 @@ /* Reverse (flip) a list */ extern void rev(environment *env) { - stackitem *old_head, *new_head, *item; + value *old_head, *new_head, *item; - if((env->head)==NULL) { + if(env->head->type==empty) { printerr("Too Few Arguments"); env->err= 1; return; } - if(env->head->item->type!=list) { + if(CAR(env->head)->type==empty) + return; /* Don't reverse an empty list */ + + if(CAR(env->head)->type!=tcons) { printerr("Bad Argument Type"); env->err= 2; return; } - old_head= (stackitem *)(env->head->item->content.ptr); - new_head= NULL; - while(old_head != NULL){ + old_head= CAR(env->head); + new_head= new_val(env); + new_head->type= empty; + while(old_head->type != empty) { item= old_head; - old_head= old_head->next; - item->next= new_head; + old_head= CDR(old_head); + CDR(item)= new_head; new_head= item; } - env->head->item->content.ptr= new_head; + CAR(env->head)= new_head; } /* Make a list. */ extern void pack(environment *env) { - stackitem *iterator, *temp; - value *pack; + value *iterator, *temp, *ending; - iterator= env->head; - pack= new_val(env); - protect(pack); + ending=new_val(env); + ending->type=empty; - if(iterator==NULL - || (iterator->item->type==symb - && ((symbol*)(iterator->item->content.ptr))->id[0]=='[')) { - temp= NULL; + iterator= env->head; + if(iterator->type == empty + || (CAR(iterator)->type==symb + && CAR(iterator)->content.sym->id[0]=='[')) { + temp= ending; 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; + while(CDR(iterator)->type != empty + && (CAR(CDR(iterator))->type!=symb + || CAR(CDR(iterator))->content.sym->id[0]!='[')) + iterator= CDR(iterator); /* Extract list */ temp= env->head; - env->head= iterator->next; - iterator->next= NULL; + env->head= CDR(iterator); + CDR(iterator)= ending; - pack->type= list; - pack->content.ptr= temp; - - if(env->head!=NULL) + if(env->head->type != empty) toss(env); } /* Push list */ - push_val(env, pack); + push_val(env, temp); rev(env); - - unprotect(pack); } /* Relocate elements of the list on the stack. */ extern void expand(environment *env) { - stackitem *temp, *new_head; + value *temp, *new_head; /* Is top element a list? */ - if(env->head==NULL) { + if(env->head->type==empty) { printerr("Too Few Arguments"); env->err= 1; return; } - if(env->head->item->type!=list) { + + if(CAR(env->head)->type!=tcons) { printerr("Bad Argument Type"); env->err= 2; return; @@ -775,16 +834,23 @@ return; /* The first list element is the new stack head */ - new_head= temp= env->head->item->content.ptr; + new_head= temp= CAR(env->head); toss(env); /* Find the end of the list */ - while(temp->next!=NULL) - temp= temp->next; + while(CDR(temp)->type != empty) { + if (CDR(temp)->type == tcons) + temp= CDR(temp); + else { + printerr("Bad Argument Type"); /* Improper list */ + env->err= 2; + return; + } + } /* Connect the tail of the list with the old stack head */ - temp->next= env->head; + CDR(temp)= env->head; env->head= new_head; /* ...and voila! */ } @@ -793,21 +859,18 @@ extern void eq(environment *env) { void *left, *right; - int result; - if((env->head)==NULL || env->head->next==NULL) { + if(env->head->type==empty || CDR(env->head)->type==empty) { printerr("Too Few Arguments"); env->err= 1; return; } - left= env->head->item->content.ptr; - swap(env); - right= env->head->item->content.ptr; - result= (left==right); - + left= CAR(env->head)->content.ptr; + right= CAR(CDR(env->head))->content.ptr; toss(env); toss(env); - push_int(env, result); + + push_int(env, left==right); } /* Negates the top element on the stack. */ @@ -815,19 +878,19 @@ { int val; - if((env->head)==NULL) { + if(env->head->type==empty) { printerr("Too Few Arguments"); env->err= 1; return; } - if(env->head->item->type!=integer) { + if(CAR(env->head)->type!=integer) { printerr("Bad Argument Type"); env->err= 2; return; } - val= env->head->item->content.i; + val= CAR(env->head)->content.i; toss(env); push_int(env, !val); } @@ -846,23 +909,23 @@ symbol *sym; /* Needs two values on the stack, the top one must be a symbol */ - if(env->head==NULL || env->head->next==NULL) { + if(env->head->type==empty || CDR(env->head)->type==empty) { printerr("Too Few Arguments"); env->err= 1; return; } - if(env->head->item->type!=symb) { + if(CAR(env->head)->type!=symb) { printerr("Bad Argument Type"); env->err= 2; return; } /* long names are a pain */ - sym= env->head->item->content.ptr; + sym= CAR(env->head)->content.ptr; /* Bind the symbol to the value */ - sym->val= env->head->next->item; + sym->val= CAR(CDR(env->head)); toss(env); toss(env); } @@ -885,10 +948,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); } @@ -896,7 +963,7 @@ /* Clear stack */ extern void clear(environment *env) { - while(env->head!=NULL) + while(env->head->type != empty) toss(env); } @@ -909,6 +976,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; } @@ -931,21 +1002,20 @@ extern void forget(environment *env) { char* sym_id; - stackitem *stack_head= env->head; - if(stack_head==NULL) { + if(env->head->type==empty) { printerr("Too Few Arguments"); - env->err=1; + env->err= 1; return; } - if(stack_head->item->type!=symb) { + if(CAR(env->head)->type!=symb) { printerr("Bad Argument Type"); - env->err=2; + env->err= 2; return; } - sym_id= ((symbol*)(stack_head->item->content.ptr))->id; + sym_id= CAR(env->head)->content.sym->id; toss(env); return forget_sym(hash(env->symbols, sym_id)); @@ -963,7 +1033,9 @@ int c; /* getopt option character */ +#ifdef __linux__ mtrace(); +#endif init_env(&myenv); @@ -977,7 +1049,7 @@ break; case '?': fprintf (stderr, - "Unknown option character `\\x%x'.\n", + "Unknown option character '\\x%x'.\n", optopt); return EX_USAGE; default: @@ -994,11 +1066,11 @@ } if(myenv.interactive) { - printf("Stack version $Revision: 1.99 $\n\ + printf("Stack version $Revision: 1.116 $\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) { @@ -1013,12 +1085,14 @@ } myenv.err=0; } - sx_72656164(&myenv); - if (myenv.err==4) { - return EXIT_SUCCESS; /* EOF */ - } else if(myenv.head!=NULL - && myenv.head->item->type==symb - && ((symbol*)(myenv.head->item->content.ptr))->id[0]==';') { + sx_72656164(&myenv); /* "read" */ + if (myenv.err==4) { /* EOF */ + myenv.err=0; + quit(&myenv); + } else if(myenv.head->type!=empty + && CAR(myenv.head)->type==symb + && CAR(myenv.head)->content.sym->id[0] + ==';') { toss(&myenv); /* No error check in main */ eval(&myenv); } @@ -1037,16 +1111,16 @@ char* new_string; value *a_val, *b_val; - if((env->head)==NULL || env->head->next==NULL) { + if(env->head->type==empty || CDR(env->head)->type==empty) { printerr("Too Few Arguments"); env->err= 1; return; } - if(env->head->item->type==string - && env->head->next->item->type==string) { - a_val= env->head->item; - b_val= env->head->next->item; + if(CAR(env->head)->type==string + && CAR(CDR(env->head))->type==string) { + a_val= CAR(env->head); + b_val= CAR(CDR(env->head)); protect(a_val); protect(b_val); toss(env); if(env->err) return; toss(env); if(env->err) return; @@ -1061,44 +1135,44 @@ return; } - if(env->head->item->type==integer - && env->head->next->item->type==integer) { - a=env->head->item->content.i; + if(CAR(env->head)->type==integer + && CAR(CDR(env->head))->type==integer) { + a= CAR(env->head)->content.i; toss(env); if(env->err) return; - b=env->head->item->content.i; + b= CAR(env->head)->content.i; toss(env); if(env->err) return; push_int(env, b+a); return; } - if(env->head->item->type==tfloat - && env->head->next->item->type==tfloat) { - fa= env->head->item->content.f; + if(CAR(env->head)->type==tfloat + && CAR(CDR(env->head))->type==tfloat) { + fa= CAR(env->head)->content.f; toss(env); if(env->err) return; - fb= env->head->item->content.f; + fb= CAR(env->head)->content.f; toss(env); if(env->err) return; push_float(env, fb+fa); return; } - if(env->head->item->type==tfloat - && env->head->next->item->type==integer) { - fa= env->head->item->content.f; + if(CAR(env->head)->type==tfloat + && CAR(CDR(env->head))->type==integer) { + fa= CAR(env->head)->content.f; toss(env); if(env->err) return; - b= env->head->item->content.i; + b= CAR(env->head)->content.i; toss(env); if(env->err) return; push_float(env, b+fa); return; } - if(env->head->item->type==integer - && env->head->next->item->type==tfloat) { - a= env->head->item->content.i; + if(CAR(env->head)->type==integer + && CAR(CDR(env->head))->type==tfloat) { + a= CAR(env->head)->content.i; toss(env); if(env->err) return; - fb= env->head->item->content.f; + fb= CAR(env->head)->content.f; toss(env); if(env->err) return; push_float(env, fb+a); @@ -1115,50 +1189,50 @@ int a, b; float fa, fb; - if((env->head)==NULL || env->head->next==NULL) { + if(env->head->type==empty || CDR(env->head)->type==empty) { printerr("Too Few Arguments"); env->err=1; return; } - if(env->head->item->type==integer - && env->head->next->item->type==integer) { - a=env->head->item->content.i; + if(CAR(env->head)->type==integer + && CAR(CDR(env->head))->type==integer) { + a= CAR(env->head)->content.i; toss(env); if(env->err) return; - b=env->head->item->content.i; + b= CAR(env->head)->content.i; toss(env); if(env->err) return; push_int(env, b-a); return; } - if(env->head->item->type==tfloat - && env->head->next->item->type==tfloat) { - fa= env->head->item->content.f; + if(CAR(env->head)->type==tfloat + && CAR(CDR(env->head))->type==tfloat) { + fa= CAR(env->head)->content.f; toss(env); if(env->err) return; - fb= env->head->item->content.f; + fb= CAR(env->head)->content.f; toss(env); if(env->err) return; push_float(env, fb-fa); return; } - if(env->head->item->type==tfloat - && env->head->next->item->type==integer) { - fa= env->head->item->content.f; + if(CAR(env->head)->type==tfloat + && CAR(CDR(env->head))->type==integer) { + fa= CAR(env->head)->content.f; toss(env); if(env->err) return; - b= env->head->item->content.i; + b= CAR(env->head)->content.i; toss(env); if(env->err) return; push_float(env, b-fa); return; } - if(env->head->item->type==integer - && env->head->next->item->type==tfloat) { - a= env->head->item->content.i; + if(CAR(env->head)->type==integer + && CAR(CDR(env->head))->type==tfloat) { + a= CAR(env->head)->content.i; toss(env); if(env->err) return; - fb= env->head->item->content.f; + fb= CAR(env->head)->content.f; toss(env); if(env->err) return; push_float(env, fb-a); @@ -1175,50 +1249,50 @@ int a, b; float fa, fb; - if((env->head)==NULL || env->head->next==NULL) { + if(env->head->type==empty || CDR(env->head)->type==empty) { printerr("Too Few Arguments"); - env->err=1; + env->err= 1; return; } - if(env->head->item->type==integer - && env->head->next->item->type==integer) { - a=env->head->item->content.i; + if(CAR(env->head)->type==integer + && CAR(CDR(env->head))->type==integer) { + a= CAR(env->head)->content.i; toss(env); if(env->err) return; - b=env->head->item->content.i; + b= CAR(env->head)->content.i; toss(env); if(env->err) return; push_int(env, b>a); return; } - if(env->head->item->type==tfloat - && env->head->next->item->type==tfloat) { - fa= env->head->item->content.f; + if(CAR(env->head)->type==tfloat + && CAR(CDR(env->head))->type==tfloat) { + fa= CAR(env->head)->content.f; toss(env); if(env->err) return; - fb= env->head->item->content.f; + fb= CAR(env->head)->content.f; toss(env); if(env->err) return; push_int(env, fb>fa); return; } - if(env->head->item->type==tfloat - && env->head->next->item->type==integer) { - fa= env->head->item->content.f; + if(CAR(env->head)->type==tfloat + && CAR(CDR(env->head))->type==integer) { + fa= CAR(env->head)->content.f; toss(env); if(env->err) return; - b= env->head->item->content.i; + b= CAR(env->head)->content.i; toss(env); if(env->err) return; push_int(env, b>fa); return; } - if(env->head->item->type==integer - && env->head->next->item->type==tfloat) { - a= env->head->item->content.i; + if(CAR(env->head)->type==integer + && CAR(CDR(env->head))->type==tfloat) { + a= CAR(env->head)->content.i; toss(env); if(env->err) return; - fb= env->head->item->content.f; + fb= CAR(env->head)->content.f; toss(env); if(env->err) return; push_int(env, fb>a); @@ -1226,7 +1300,7 @@ } printerr("Bad Argument Type"); - env->err=2; + env->err= 2; } /* "<" */ @@ -1253,12 +1327,13 @@ /* Return copy of a value */ value *copy_val(environment *env, value *old_value) { - stackitem *old_item, *new_item, *prev_item; value *new_value; + if(old_value==NULL) + return NULL; + protect(old_value); new_value= new_val(env); - protect(new_value); new_value->type= old_value->type; switch(old_value->type){ @@ -1266,34 +1341,25 @@ case integer: case func: case symb: + case empty: new_value->content= old_value->content; break; case string: (char *)(new_value->content.ptr)= strdup((char *)(old_value->content.ptr)); break; - case list: - new_value->content.ptr= NULL; + case tcons: - prev_item= NULL; - old_item= (stackitem*)(old_value->content.ptr); + new_value->content.c= malloc(sizeof(pair)); + assert(new_value->content.c!=NULL); + env->gc_count += sizeof(pair); - while(old_item != NULL) { /* While list is not empty */ - new_item= malloc(sizeof(stackitem)); - new_item->item= copy_val(env, 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; - } + 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; } @@ -1301,12 +1367,12 @@ /* "dup"; duplicates an item on the stack */ extern void sx_647570(environment *env) { - if((env->head)==NULL) { + if(env->head->type==empty) { printerr("Too Few Arguments"); env->err= 1; return; } - push_val(env, copy_val(env, env->head->item)); + push_val(env, copy_val(env, CAR(env->head))); } /* "if", If-Then */ @@ -1314,22 +1380,22 @@ { int truth; - if((env->head)==NULL || env->head->next==NULL) { + if(env->head->type==empty || CDR(env->head)->type==empty) { printerr("Too Few Arguments"); env->err= 1; return; } - if(env->head->next->item->type != integer) { + if(CAR(CDR(env->head))->type != integer) { printerr("Bad Argument Type"); - env->err=2; + env->err= 2; return; } swap(env); if(env->err) return; - truth=env->head->item->content.i; + truth= CAR(env->head)->content.i; toss(env); if(env->err) return; @@ -1345,23 +1411,23 @@ { int truth; - if((env->head)==NULL || env->head->next==NULL - || env->head->next->next==NULL) { + if(env->head->type==empty || CDR(env->head)->type==empty + || CDR(CDR(env->head))->type==empty) { printerr("Too Few Arguments"); - env->err=1; + env->err= 1; return; } - if(env->head->next->next->item->type != integer) { + if(CAR(CDR(CDR(env->head)))->type!=integer) { printerr("Bad Argument Type"); - env->err=2; + env->err= 2; return; } rot(env); if(env->err) return; - truth=env->head->item->content.i; + truth= CAR(env->head)->content.i; toss(env); if(env->err) return; @@ -1376,23 +1442,66 @@ eval(env); } +extern void sx_656c7365(environment *env) +{ + if(env->head->type==empty || CDR(env->head)->type==empty + || CDR(CDR(env->head))->type==empty || CDR(CDR(CDR(env->head)))->type==empty + || CDR(CDR(CDR(CDR(env->head))))->type==empty) { + 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->type==empty || CDR(env->head)->type==empty + || CDR(CDR(env->head))->type==empty) { + printerr("Too Few Arguments"); + env->err= 1; + return; + } + + if(CAR(CDR(env->head))->type!=symb + || strcmp(CAR(CDR(env->head))->content.sym->id, "if")!=0) { + printerr("Bad Argument Type"); + env->err= 2; + return; + } + + swap(env); toss(env); + sx_6966(env); +} + /* "while" */ extern void sx_7768696c65(environment *env) { int truth; value *loop, *test; - if((env->head)==NULL || env->head->next==NULL) { + if(env->head->type==empty || CDR(env->head)->type==empty) { printerr("Too Few Arguments"); - env->err=1; + env->err= 1; return; } - loop= env->head->item; + loop= CAR(env->head); protect(loop); toss(env); if(env->err) return; - test= env->head->item; + test= CAR(env->head); protect(test); toss(env); if(env->err) return; @@ -1400,13 +1509,13 @@ push_val(env, test); eval(env); - if(env->head->item->type != integer) { + if(CAR(env->head)->type != integer) { printerr("Bad Argument Type"); env->err= 2; return; } - truth= env->head->item->content.i; + truth= CAR(env->head)->content.i; toss(env); if(env->err) return; if(truth) { @@ -1428,28 +1537,28 @@ value *loop; int foo1, foo2; - if(env->head==NULL || env->head->next==NULL - || env->head->next->next==NULL) { + if(env->head->type==empty || CDR(env->head)->type==empty + || CDR(CDR(env->head))->type==empty) { printerr("Too Few Arguments"); env->err= 1; return; } - if(env->head->next->item->type!=integer - || env->head->next->next->item->type!=integer) { + if(CAR(CDR(env->head))->type!=integer + || CAR(CDR(CDR(env->head)))->type!=integer) { printerr("Bad Argument Type"); env->err= 2; return; } - loop= env->head->item; + loop= CAR(env->head); protect(loop); toss(env); if(env->err) return; - foo2= env->head->item->content.i; + foo2= CAR(env->head)->content.i; toss(env); if(env->err) return; - foo1= env->head->item->content.i; + foo1= CAR(env->head)->content.i; toss(env); if(env->err) return; if(foo1<=foo2) { @@ -1474,35 +1583,41 @@ extern void foreach(environment *env) { value *loop, *foo; - stackitem *iterator; + value *iterator; - if((env->head)==NULL || env->head->next==NULL) { + if(env->head->type==empty || CDR(env->head)->type==empty) { printerr("Too Few Arguments"); env->err= 1; return; } - if(env->head->next->item->type != list) { + if(CAR(CDR(env->head))->type!=tcons) { printerr("Bad Argument Type"); env->err= 2; return; } - loop= env->head->item; + loop= CAR(env->head); protect(loop); toss(env); if(env->err) return; - foo= env->head->item; + foo= CAR(env->head); protect(foo); toss(env); if(env->err) return; - iterator= foo->content.ptr; + iterator= foo; while(iterator!=NULL) { - push_val(env, iterator->item); + push_val(env, CAR(iterator)); push_val(env, loop); eval(env); if(env->err) return; - iterator= iterator->next; + if (iterator->type == tcons){ + iterator= CDR(iterator); + } else { + printerr("Bad Argument Type"); /* Improper list */ + env->err= 2; + break; + } } unprotect(loop); unprotect(foo); } @@ -1511,25 +1626,24 @@ extern void to(environment *env) { int ending, start, i; - stackitem *iterator, *temp; - value *pack; + value *iterator, *temp; - if((env->head)==NULL || env->head->next==NULL) { + if(env->head->type==empty || CDR(env->head)->type==empty) { printerr("Too Few Arguments"); - env->err=1; + env->err= 1; return; } - if(env->head->item->type!=integer - || env->head->next->item->type!=integer) { + if(CAR(env->head)->type!=integer + || CAR(CDR(env->head))->type!=integer) { printerr("Bad Argument Type"); - env->err=2; + env->err= 2; return; } - ending= env->head->item->content.i; + ending= CAR(env->head)->content.i; toss(env); if(env->err) return; - start= env->head->item->content.i; + start= CAR(env->head)->content.i; toss(env); if(env->err) return; push_sym(env, "["); @@ -1543,38 +1657,30 @@ } iterator= env->head; - pack= new_val(env); - protect(pack); - if(iterator==NULL - || (iterator->item->type==symb - && ((symbol*)(iterator->item->content.ptr))->id[0]=='[')) { + if(iterator->type==empty + || (CAR(iterator)->type==symb + && CAR(iterator)->content.sym->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; + while(CDR(iterator)!=NULL + && (CAR(CDR(iterator))->type!=symb + || CAR(CDR(iterator))->content.sym->id[0]!='[')) + iterator= CDR(iterator); /* Extract list */ temp= env->head; - env->head= iterator->next; - iterator->next= NULL; + env->head= CDR(iterator); + CDR(iterator)= NULL; - pack->type= list; - pack->content.ptr= temp; - if(env->head!=NULL) toss(env); } /* Push list */ - - push_val(env, pack); - - unprotect(pack); + push_val(env, temp); } /* Read a string */ @@ -1604,7 +1710,7 @@ int count= -1; float ftemp; static int depth= 0; - char *match, *ctemp; + char *match; size_t inlength; if(env->in_string==NULL) { @@ -1613,14 +1719,14 @@ } readline(env); if(env->err) return; - if(((char *)(env->head->item->content.ptr))[0]=='\0'){ + if(((char *)(CAR(env->head)->content.ptr))[0]=='\0'){ env->err= 4; /* "" means EOF */ return; } - env->in_string= malloc(strlen(env->head->item->content.ptr)+1); + env->in_string= malloc(strlen(CAR(env->head)->content.ptr)+1); env->free_string= env->in_string; /* Save the original pointer */ - strcpy(env->in_string, env->head->item->content.ptr); + strcpy(env->in_string, CAR(env->head)->content.ptr); toss(env); if(env->err) return; } @@ -1638,6 +1744,9 @@ } else { push_float(env, ftemp); } + } else if(sscanf(env->in_string, "\"\"%n", &readlength) != EOF + && readlength != -1) { + push_cstring(env, ""); } else if(sscanf(env->in_string, strform, match, &readlength) != EOF && readlength != -1) { push_cstring(env, match); @@ -1669,67 +1778,69 @@ return sx_72656164(env); } +#ifdef __linux__ extern void beep(environment *env) { int freq, dur, period, ticks; - if((env->head)==NULL || env->head->next==NULL) { + if(env->head->type==empty || CDR(env->head)->type==empty) { printerr("Too Few Arguments"); - env->err=1; + env->err= 1; return; } - if(env->head->item->type!=integer - || env->head->next->item->type!=integer) { + if(CAR(env->head)->type!=integer + || CAR(CDR(env->head))->type!=integer) { printerr("Bad Argument Type"); - env->err=2; + env->err= 2; return; } - dur=env->head->item->content.i; + dur= CAR(env->head)->content.i; toss(env); - freq=env->head->item->content.i; + freq= CAR(env->head)->content.i; toss(env); - period=1193180/freq; /* convert freq from Hz to period + period= 1193180/freq; /* convert freq from Hz to period length */ - ticks=dur*.001193180; /* convert duration from µseconds to + ticks= dur*.001193180; /* convert duration from µseconds to timer ticks */ /* ticks=dur/1000; */ - /* if (ioctl(STDOUT_FILENO, KDMKTONE, (125<<16) + 0x637)==0) */ + /* if (ioctl(STDOUT_FILENO, KDMKTONE, (125<<16) + 0x637)==0) */ switch (ioctl(STDOUT_FILENO, KDMKTONE, (ticks<<16) | period)){ case 0: usleep(dur); return; case -1: perror("beep"); - env->err=5; + env->err= 5; return; default: abort(); } } +#endif /* __linux__ */ /* "wait" */ extern void sx_77616974(environment *env) { int dur; - if((env->head)==NULL) { + if(env->head->type==empty) { printerr("Too Few Arguments"); - env->err=1; + env->err= 1; return; } - if(env->head->item->type!=integer) { + if(CAR(env->head)->type!=integer) { printerr("Bad Argument Type"); - env->err=2; + env->err= 2; return; } - dur=env->head->item->content.i; + dur= CAR(env->head)->content.i; toss(env); usleep(dur); @@ -1737,7 +1848,7 @@ extern void copying(environment *env) { - printf("GNU GENERAL PUBLIC LICENSE\n\ + printf(" GNU GENERAL PUBLIC LICENSE\n\ Version 2, June 1991\n\ \n\ Copyright (C) 1989, 1991 Free Software Foundation, Inc.\n\ @@ -2026,50 +2137,50 @@ int a, b; float fa, fb; - if((env->head)==NULL || env->head->next==NULL) { + if(env->head->type==empty || CDR(env->head)->type==empty) { printerr("Too Few Arguments"); - env->err=1; + env->err= 1; return; } - if(env->head->item->type==integer - && env->head->next->item->type==integer) { - a=env->head->item->content.i; + if(CAR(env->head)->type==integer + && CAR(CDR(env->head))->type==integer) { + a= CAR(env->head)->content.i; toss(env); if(env->err) return; - b=env->head->item->content.i; + b= CAR(env->head)->content.i; toss(env); if(env->err) return; push_int(env, b*a); return; } - if(env->head->item->type==tfloat - && env->head->next->item->type==tfloat) { - fa= env->head->item->content.f; + if(CAR(env->head)->type==tfloat + && CAR(CDR(env->head))->type==tfloat) { + fa= CAR(env->head)->content.f; toss(env); if(env->err) return; - fb= env->head->item->content.f; + fb= CAR(env->head)->content.f; toss(env); if(env->err) return; push_float(env, fb*fa); return; } - if(env->head->item->type==tfloat - && env->head->next->item->type==integer) { - fa= env->head->item->content.f; + if(CAR(env->head)->type==tfloat + && CAR(CDR(env->head))->type==integer) { + fa= CAR(env->head)->content.f; toss(env); if(env->err) return; - b= env->head->item->content.i; + b= CAR(env->head)->content.i; toss(env); if(env->err) return; push_float(env, b*fa); return; } - if(env->head->item->type==integer - && env->head->next->item->type==tfloat) { - a= env->head->item->content.i; + if(CAR(env->head)->type==integer + && CAR(CDR(env->head))->type==tfloat) { + a= CAR(env->head)->content.i; toss(env); if(env->err) return; - fb= env->head->item->content.f; + fb= CAR(env->head)->content.f; toss(env); if(env->err) return; push_float(env, fb*a); @@ -2077,7 +2188,7 @@ } printerr("Bad Argument Type"); - env->err=2; + env->err= 2; } /* "/" */ @@ -2086,50 +2197,50 @@ int a, b; float fa, fb; - if((env->head)==NULL || env->head->next==NULL) { + if(env->head->type==empty || CDR(env->head)->type==empty) { printerr("Too Few Arguments"); - env->err=1; + env->err= 1; return; } - if(env->head->item->type==integer - && env->head->next->item->type==integer) { - a=env->head->item->content.i; + if(CAR(env->head)->type==integer + && CAR(CDR(env->head))->type==integer) { + a= CAR(env->head)->content.i; toss(env); if(env->err) return; - b=env->head->item->content.i; + b= CAR(env->head)->content.i; toss(env); if(env->err) return; push_float(env, b/a); return; } - if(env->head->item->type==tfloat - && env->head->next->item->type==tfloat) { - fa= env->head->item->content.f; + if(CAR(env->head)->type==tfloat + && CAR(CDR(env->head))->type==tfloat) { + fa= CAR(env->head)->content.f; toss(env); if(env->err) return; - fb= env->head->item->content.f; + fb= CAR(env->head)->content.f; toss(env); if(env->err) return; push_float(env, fb/fa); return; } - if(env->head->item->type==tfloat - && env->head->next->item->type==integer) { - fa= env->head->item->content.f; + if(CAR(env->head)->type==tfloat + && CAR(CDR(env->head))->type==integer) { + fa= CAR(env->head)->content.f; toss(env); if(env->err) return; - b= env->head->item->content.i; + b= CAR(env->head)->content.i; toss(env); if(env->err) return; push_float(env, b/fa); return; } - if(env->head->item->type==integer - && env->head->next->item->type==tfloat) { - a= env->head->item->content.i; + if(CAR(env->head)->type==integer + && CAR(CDR(env->head))->type==tfloat) { + a= CAR(env->head)->content.i; toss(env); if(env->err) return; - fb= env->head->item->content.f; + fb= CAR(env->head)->content.f; toss(env); if(env->err) return; push_float(env, fb/a); @@ -2137,7 +2248,7 @@ } printerr("Bad Argument Type"); - env->err=2; + env->err= 2; } /* "mod" */ @@ -2145,17 +2256,17 @@ { int a, b; - if((env->head)==NULL || env->head->next==NULL) { + if(env->head->type==empty || CDR(env->head)->type==empty) { printerr("Too Few Arguments"); env->err= 1; return; } - if(env->head->item->type==integer - && env->head->next->item->type==integer) { - a= env->head->item->content.i; + if(CAR(env->head)->type==integer + && CAR(CDR(env->head))->type==integer) { + a= CAR(env->head)->content.i; toss(env); if(env->err) return; - b= env->head->item->content.i; + b= CAR(env->head)->content.i; toss(env); if(env->err) return; push_int(env, b%a); @@ -2163,7 +2274,7 @@ } printerr("Bad Argument Type"); - env->err=2; + env->err= 2; } /* "div" */ @@ -2171,17 +2282,17 @@ { int a, b; - if((env->head)==NULL || env->head->next==NULL) { + if(env->head->type==empty || CDR(env->head)->type==empty) { printerr("Too Few Arguments"); env->err= 1; return; } - if(env->head->item->type==integer - && env->head->next->item->type==integer) { - a= env->head->item->content.i; + if(CAR(env->head)->type==integer + && CAR(CDR(env->head))->type==integer) { + a= CAR(env->head)->content.i; toss(env); if(env->err) return; - b= env->head->item->content.i; + b= CAR(env->head)->content.i; toss(env); if(env->err) return; push_int(env, (int)b/a); @@ -2191,3 +2302,101 @@ printerr("Bad Argument Type"); env->err= 2; } + +extern void setcar(environment *env) +{ + if(env->head->type==empty || CDR(env->head)->type==empty) { + printerr("Too Few Arguments"); + env->err= 1; + return; + } + + if(CDR(env->head)->type!=tcons) { + printerr("Bad Argument Type"); + env->err= 2; + return; + } + + CAR(CAR(CDR(env->head)))=CAR(env->head); + toss(env); +} + +extern void setcdr(environment *env) +{ + if(env->head->type==empty || CDR(env->head)->type==empty) { + printerr("Too Few Arguments"); + env->err= 1; + return; + } + + if(CDR(env->head)->type!=tcons) { + printerr("Bad Argument Type"); + env->err= 2; + return; + } + + CDR(CAR(CDR(env->head)))=CAR(env->head); + toss(env); +} + +extern void car(environment *env) +{ + if(env->head->type==empty) { + printerr("Too Few Arguments"); + env->err= 1; + return; + } + + if(CAR(env->head)->type!=tcons) { + printerr("Bad Argument Type"); + env->err= 2; + return; + } + + CAR(env->head)=CAR(CAR(env->head)); +} + +extern void cdr(environment *env) +{ + if(env->head->type==empty) { + printerr("Too Few Arguments"); + env->err= 1; + return; + } + + if(CAR(env->head)->type!=tcons) { + printerr("Bad Argument Type"); + env->err= 2; + return; + } + + CAR(env->head)=CDR(CAR(env->head)); +} + +extern void cons(environment *env) +{ + value *val; + + if(env->head->type==empty || CDR(env->head)->type==empty) { + printerr("Too Few Arguments"); + env->err= 1; + return; + } + + val=new_val(env); + val->content.c= malloc(sizeof(pair)); + assert(val->content.c!=NULL); + + env->gc_count += sizeof(pair); + val->type=tcons; + + CAR(val)= CAR(CDR(env->head)); + CDR(val)= CAR(env->head); + + push_val(env, val); + + swap(env); if(env->err) return; + toss(env); if(env->err) return; + swap(env); if(env->err) return; + toss(env); if(env->err) return; +}