/[cvs]/stack/stack.c
ViewVC logotype

Diff of /stack/stack.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.101 by teddy, Sun Mar 10 13:00:01 2002 UTC revision 1.103 by teddy, Mon Mar 11 08:52:59 2002 UTC
# Line 70  void printerr(const char* in_string) Line 70  void printerr(const char* in_string)
70  /* Discard the top element of the stack. */  /* Discard the top element of the stack. */
71  extern void toss(environment *env)  extern void toss(environment *env)
72  {  {
73    stackitem *temp= env->head;    cons *temp= env->head;
74    
75    if((env->head)==NULL) {    if(env->head==NULL) {
76      printerr("Too Few Arguments");      printerr("Too Few Arguments");
77      env->err= 1;      env->err= 1;
78      return;      return;
79    }    }
80        
81    env->head= env->head->next;   /* Remove the top stack item */    env->head= env->head->cdr->content.c; /* Remove the top stack item */
82    free(temp);                   /* Free the old top stack item */    free(temp);                   /* Free the old top stack item */
83  }  }
84    
# Line 121  value* new_val(environment *env) Line 121  value* new_val(environment *env)
121    
122    nitem->item= nval;    nitem->item= nval;
123    nitem->next= env->gc_ref;    nitem->next= env->gc_ref;
124    
125    env->gc_ref= nitem;    env->gc_ref= nitem;
126    
127    env->gc_count += sizeof(value);    env->gc_count += sizeof(value);
# Line 134  value* new_val(environment *env) Line 135  value* new_val(environment *env)
135     Marked values are not collected by the GC. */     Marked values are not collected by the GC. */
136  inline void gc_mark(value *val)  inline void gc_mark(value *val)
137  {  {
138    stackitem *iterator;    if(val==NULL || val->gc.flag.mark)
   
   if(val->gc.flag.mark)  
139      return;      return;
140    
141    val->gc.flag.mark= 1;    val->gc.flag.mark= 1;
142    
143    if(val->type==list) {    if(val->type==tcons && val->content.c!=NULL) {
144      iterator= val->content.ptr;      gc_mark(val->content.c->car);
145        gc_mark(val->content.c->cdr);
     while(iterator!=NULL) {  
       gc_mark(iterator->item);  
       iterator= iterator->next;  
     }  
146    }    }
147  }  }
148    
# Line 162  inline void gc_maybe(environment *env) Line 157  inline void gc_maybe(environment *env)
157  /* Start GC */  /* Start GC */
158  extern void gc_init(environment *env)  extern void gc_init(environment *env)
159  {  {
160    stackitem *new_head= NULL, *titem, *iterator;    stackitem *new_head= NULL, *titem;
161      cons *iterator;
162    symbol *tsymb;    symbol *tsymb;
163    int i;    int i;
164    
165    if(env->interactive){    if(env->interactive)
166      printf("Garbage collecting.");      printf("Garbage collecting.");
   }  
167    
168    /* Mark values on stack */    /* Mark values on stack */
169    iterator= env->head;    if(env->head!=NULL) {
170    while(iterator!=NULL) {      gc_mark(env->head->car);
171      gc_mark(iterator->item);      gc_mark(env->head->cdr);
     iterator= iterator->next;  
172    }    }
173    
174    if(env->interactive){    if(env->interactive)
175      printf(".");      printf(".");
176    }  
177    
178    /* Mark values in hashtable */    /* Mark values in hashtable */
179    for(i= 0; i<HASHTBLSIZE; i++) {    for(i= 0; i<HASHTBLSIZE; i++)
180      tsymb= env->symbols[i];      for(tsymb= env->symbols[i]; tsymb!=NULL; tsymb= tsymb->next)
     while(tsymb!=NULL) {  
181        if (tsymb->val != NULL)        if (tsymb->val != NULL)
182          gc_mark(tsymb->val);          gc_mark(tsymb->val);
       tsymb= tsymb->next;  
     }  
   }  
183    
184    if(env->interactive){  
185      if(env->interactive)
186      printf(".");      printf(".");
187    }  
188    
189    env->gc_count= 0;    env->gc_count= 0;
190    
# Line 201  extern void gc_init(environment *env) Line 192  extern void gc_init(environment *env)
192    
193      if(!(env->gc_ref->item->gc.no_gc)){ /* neither mark nor protect */      if(!(env->gc_ref->item->gc.no_gc)){ /* neither mark nor protect */
194    
195        switch(env->gc_ref->item->type) { /* Remove content */        if(env->gc_ref->item->type==string) /* Remove content */
       case string:  
196          free(env->gc_ref->item->content.ptr);          free(env->gc_ref->item->content.ptr);
197          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:  
       }  
198        free(env->gc_ref->item);  /* Remove from gc_ref */        free(env->gc_ref->item);  /* Remove from gc_ref */
199        titem= env->gc_ref->next;        titem= env->gc_ref->next;
200        free(env->gc_ref);        /* Remove value */        free(env->gc_ref);        /* Remove value */
201        env->gc_ref= titem;        env->gc_ref= titem;
202        continue;        continue;
203      } else {      }
204        env->gc_count += sizeof(value);  
205        if(env->gc_ref->item->type == string)      /* Keep values */    
206          env->gc_count += strlen(env->gc_ref->item->content.ptr);      env->gc_count += sizeof(value);
207      }      if(env->gc_ref->item->type==string)
208          env->gc_count += strlen(env->gc_ref->item->content.ptr);
209            
     /* Keep values */  
210      titem= env->gc_ref->next;      titem= env->gc_ref->next;
211      env->gc_ref->next= new_head;      env->gc_ref->next= new_head;
212      new_head= env->gc_ref;      new_head= env->gc_ref;
# Line 237  extern void gc_init(environment *env) Line 219  extern void gc_init(environment *env)
219    
220    env->gc_ref= new_head;    env->gc_ref= new_head;
221    
222    if(env->interactive){    if(env->interactive)
223      printf("done\n");      printf("done\n");
   }  
224    
225  }  }
226    
227  /* Protect values from GC */  /* Protect values from GC */
228  void protect(value *val)  void protect(value *val)
229  {  {
230    stackitem *iterator;    if(val==NULL || val->gc.flag.protect)
   
   if(val->gc.flag.protect)  
231      return;      return;
232    
233    val->gc.flag.protect= 1;    val->gc.flag.protect= 1;
234    
235    if(val->type==list) {    if(val->type==tcons && val->content.c!=NULL) {
236      iterator= val->content.ptr;      protect(val->content.c->car);
237        protect(val->content.c->cdr);
     while(iterator!=NULL) {  
       protect(iterator->item);  
       iterator= iterator->next;  
     }  
238    }    }
239  }  }
240    
241  /* Unprotect values from GC */  /* Unprotect values from GC */
242  void unprotect(value *val)  void unprotect(value *val)
243  {  {
244    stackitem *iterator;    if(val==NULL || !(val->gc.flag.protect))
   
   if(!(val->gc.flag.protect))  
245      return;      return;
246    
247    val->gc.flag.protect= 0;    val->gc.flag.protect= 0;
248    
249    if(val->type==list) {    if(val->type==tcons && val->content.c!=NULL) {
250      iterator= val->content.ptr;      unprotect(val->content.c->car);
251        unprotect(val->content.c->cdr);
     while(iterator!=NULL) {  
       unprotect(iterator->item);  
       iterator= iterator->next;  
     }  
252    }    }
253  }  }
254    
255  /* Push a value onto the stack */  /* Push a value onto the stack */
256  void push_val(environment *env, value *val)  void push_val(environment *env, value *val)
257  {  {
258    stackitem *new_item= malloc(sizeof(stackitem));    cons *new_item= malloc(sizeof(cons));
259    new_item->item= val;    new_item->car= val;
260    new_item->next= env->head;  
261      new_item->cdr= new_val(env);
262      new_item->cdr->type= tcons;
263      new_item->cdr->content.c= env->head;
264    env->head= new_item;    env->head= new_item;
265  }  }
266    
# Line 358  extern void mangle(environment *env) Line 330  extern void mangle(environment *env)
330      return;      return;
331    }    }
332    
333    if(env->head->item->type!=string) {    if(env->head->car->type!=string) {
334      printerr("Bad Argument Type");      printerr("Bad Argument Type");
335      env->err= 2;      env->err= 2;
336      return;      return;
337    }    }
338    
339    new_string= mangle_str((const char *)(env->head->item->content.ptr));    new_string= mangle_str((const char *)(env->head->car->content.ptr));
340    
341    toss(env);    toss(env);
342    if(env->err) return;    if(env->err) return;
# Line 455  extern void type(environment *env) Line 427  extern void type(environment *env)
427      env->err=1;      env->err=1;
428      return;      return;
429    }    }
430    typenum=env->head->item->type;    typenum=env->head->car->type;
431    toss(env);    toss(env);
432    switch(typenum){    switch(typenum){
433    case integer:    case integer:
# Line 473  extern void type(environment *env) Line 445  extern void type(environment *env)
445    case func:    case func:
446      push_sym(env, "function");      push_sym(env, "function");
447      break;      break;
448    case list:    case tcons:
449      push_sym(env, "list");      push_sym(env, "list");
450      break;      break;
451    }    }
452  }      }    
453    
454  /* Prints the top element of the stack. */  /* Prints the top element of the stack. */
455  void print_h(stackitem *stack_head, int noquote)  void print_h(cons *stack_head, int noquote)
456  {  {
457    switch(stack_head->item->type) {    switch(stack_head->car->type) {
458    case integer:    case integer:
459      printf("%d", stack_head->item->content.i);      printf("%d", stack_head->car->content.i);
460      break;      break;
461    case tfloat:    case tfloat:
462      printf("%f", stack_head->item->content.f);      printf("%f", stack_head->car->content.f);
463      break;      break;
464    case string:    case string:
465      if(noquote)      if(noquote)
466        printf("%s", (char*)stack_head->item->content.ptr);        printf("%s", (char*)stack_head->car->content.ptr);
467      else      else
468        printf("\"%s\"", (char*)stack_head->item->content.ptr);        printf("\"%s\"", (char*)stack_head->car->content.ptr);
469      break;      break;
470    case symb:    case symb:
471      printf("%s", ((symbol *)(stack_head->item->content.ptr))->id);      printf("%s", ((symbol *)(stack_head->car->content.ptr))->id);
472      break;      break;
473    case func:    case func:
474      printf("#<function %p>", (funcp)(stack_head->item->content.ptr));      printf("#<function %p>", (funcp)(stack_head->car->content.ptr));
475      break;      break;
476    case list:    case tcons:
477      /* A list is just a stack, so make stack_head point to it */      /* A list is just a stack, so make stack_head point to it */
478      stack_head=(stackitem *)(stack_head->item->content.ptr);      stack_head=stack_head->car->content.c;
479      printf("[ ");      printf("[ ");
480      while(stack_head != NULL) {      while(stack_head != NULL) {
481        print_h(stack_head, noquote);        print_h(stack_head, noquote);
482        printf(" ");        printf(" ");
483        stack_head=stack_head->next;        stack_head= stack_head->cdr->content.c;
484      }      }
485      printf("]");      printf("]");
486      break;      break;
# Line 553  extern void princ(environment *env) Line 525  extern void princ(environment *env)
525  }  }
526    
527  /* Only to be called by function printstack. */  /* Only to be called by function printstack. */
528  void print_st(stackitem *stack_head, long counter)  void print_st(cons *stack_head, long counter)
529  {  {
530    if(stack_head->next != NULL)    if(stack_head->cdr->content.c != NULL)
531      print_st(stack_head->next, counter+1);      print_st(stack_head->cdr->content.c, counter+1);
532    printf("%ld: ", counter);    printf("%ld: ", counter);
533    print_h(stack_head, 0);    print_h(stack_head, 0);
534    nl();    nl();
# Line 576  extern void printstack(environment *env) Line 548  extern void printstack(environment *env)
548  /* Swap the two top elements on the stack. */  /* Swap the two top elements on the stack. */
549  extern void swap(environment *env)  extern void swap(environment *env)
550  {  {
551    stackitem *temp= env->head;    cons *temp= env->head;
552        
553    if(env->head==NULL || env->head->next==NULL) {    if(env->head==NULL || env->head->cdr->content.c==NULL) {
554      printerr("Too Few Arguments");      printerr("Too Few Arguments");
555      env->err=1;      env->err=1;
556      return;      return;
557    }    }
558    
559    env->head= env->head->next;    env->head= env->head->cdr->content.c;
560    temp->next= env->head->next;    temp->cdr->content.c= env->head->cdr->content.c;
561    env->head->next= temp;    env->head->cdr->content.c= temp;
562  }  }
563    
564  /* Rotate the first three elements on the stack. */  /* Rotate the first three elements on the stack. */
565  extern void rot(environment *env)  extern void rot(environment *env)
566  {  {
567    stackitem *temp= env->head;    cons *temp= env->head;
568        
569    if(env->head==NULL || env->head->next==NULL    if(env->head==NULL || env->head->cdr->content.c==NULL
570        || env->head->next->next==NULL) {       || env->head->cdr->content.c->cdr->content.c==NULL) {
571      printerr("Too Few Arguments");      printerr("Too Few Arguments");
572      env->err=1;      env->err=1;
573      return;      return;
574    }    }
575    
576    env->head= env->head->next->next;    env->head= env->head->cdr->content.c->cdr->content.c;
577    temp->next->next= env->head->next;    temp->cdr->content.c->cdr->content.c= env->head->cdr->content.c;
578    env->head->next= temp;    env->head->cdr->content.c= temp;
579  }  }
580    
581  /* Recall a value from a symbol, if bound */  /* Recall a value from a symbol, if bound */
# Line 611  extern void rcl(environment *env) Line 583  extern void rcl(environment *env)
583  {  {
584    value *val;    value *val;
585    
586    if(env->head == NULL) {    if(env->head==NULL) {
587      printerr("Too Few Arguments");      printerr("Too Few Arguments");
588      env->err=1;      env->err= 1;
589      return;      return;
590    }    }
591    
592    if(env->head->item->type!=symb) {    if(env->head->car->type!=symb) {
593      printerr("Bad Argument Type");      printerr("Bad Argument Type");
594      env->err=2;      env->err= 2;
595      return;      return;
596    }    }
597    
598    val=((symbol *)(env->head->item->content.ptr))->val;    val= ((symbol *)(env->head->car->content.ptr))->val;
599    if(val == NULL){    if(val == NULL){
600      printerr("Unbound Variable");      printerr("Unbound Variable");
601      env->err=3;      env->err= 3;
602      return;      return;
603    }    }
604    protect(val);    protect(val);
# Line 643  extern void eval(environment *env) Line 615  extern void eval(environment *env)
615  {  {
616    funcp in_func;    funcp in_func;
617    value* temp_val;    value* temp_val;
618    stackitem* iterator;    cons* iterator;
619    
620   eval_start:   eval_start:
621    
# Line 651  extern void eval(environment *env) Line 623  extern void eval(environment *env)
623    
624    if(env->head==NULL) {    if(env->head==NULL) {
625      printerr("Too Few Arguments");      printerr("Too Few Arguments");
626      env->err=1;      env->err= 1;
627      return;      return;
628    }    }
629    
630    switch(env->head->item->type) {    switch(env->head->car->type) {
631      /* if it's a symbol */      /* if it's a symbol */
632    case symb:    case symb:
633      rcl(env);                   /* get its contents */      rcl(env);                   /* get its contents */
634      if(env->err) return;      if(env->err) return;
635      if(env->head->item->type!=symb){ /* don't recurse symbols */      if(env->head->car->type!=symb){ /* don't recurse symbols */
636        goto eval_start;        goto eval_start;
637      }      }
638      return;      return;
639    
640      /* If it's a lone function value, run it */      /* If it's a lone function value, run it */
641    case func:    case func:
642      in_func= (funcp)(env->head->item->content.ptr);      in_func= (funcp)(env->head->car->content.ptr);
643      toss(env);      toss(env);
644      if(env->err) return;      if(env->err) return;
645      return in_func(env);      return in_func(env);
646    
647      /* If it's a list */      /* If it's a list */
648    case list:    case tcons:
649      temp_val= env->head->item;      temp_val= env->head->car;
650      protect(temp_val);      protect(temp_val);
651    
652      toss(env); if(env->err) return;      toss(env); if(env->err) return;
653      iterator= (stackitem*)temp_val->content.ptr;      iterator= (cons*)temp_val->content.ptr;
654            
655      while(iterator!=NULL) {      while(iterator!=NULL) {
656        push_val(env, iterator->item);        push_val(env, iterator->car);
657                
658        if(env->head->item->type==symb        if(env->head->car->type==symb
659           && (((symbol*)(env->head->item->content.ptr))->id[0] == ';')) {           && (((symbol*)(env->head->car->content.ptr))->id[0] == ';')) {
660          toss(env);          toss(env);
661          if(env->err) return;          if(env->err) return;
662                    
663          if(iterator->next == NULL){          if(iterator->cdr->content.ptr==NULL){
664            goto eval_start;            goto eval_start;
665          }          }
666          eval(env);          eval(env);
667          if(env->err) return;          if(env->err) return;
668        }        }
669        iterator= iterator->next;        if (iterator->cdr->type == tcons)
670            iterator= iterator->cdr->content.c;
671          else {
672            printerr("Bad Argument Type"); /* Improper list */
673            env->err= 2;
674            return;
675          }
676      }      }
677      unprotect(temp_val);      unprotect(temp_val);
678      return;      return;
# Line 707  extern void eval(environment *env) Line 685  extern void eval(environment *env)
685  /* Reverse (flip) a list */  /* Reverse (flip) a list */
686  extern void rev(environment *env)  extern void rev(environment *env)
687  {  {
688    stackitem *old_head, *new_head, *item;    cons *old_head, *new_head, *item;
689    
690    if((env->head)==NULL) {    if((env->head)==NULL) {
691      printerr("Too Few Arguments");      printerr("Too Few Arguments");
# Line 715  extern void rev(environment *env) Line 693  extern void rev(environment *env)
693      return;      return;
694    }    }
695    
696    if(env->head->item->type!=list) {    if(env->head->car->type!=tcons) {
697      printerr("Bad Argument Type");      printerr("Bad Argument Type");
698      env->err= 2;      env->err= 2;
699      return;      return;
700    }    }
701    
702    old_head= (stackitem *)(env->head->item->content.ptr);    old_head= env->head->car->content.c;
703    new_head= NULL;    new_head= NULL;
704    while(old_head != NULL){    while(old_head!=NULL) {
705      item= old_head;      item= old_head;
706      old_head= old_head->next;      old_head= old_head->cdr->content.c;
707      item->next= new_head;      item->cdr->content.c= new_head;
708      new_head= item;      new_head= item;
709    }    }
710    env->head->item->content.ptr= new_head;    env->head->car->content.ptr= new_head;
711  }  }
712    
713  /* Make a list. */  /* Make a list. */
714  extern void pack(environment *env)  extern void pack(environment *env)
715  {  {
716    stackitem *iterator, *temp;    cons *iterator, *temp;
717    value *pack;    value *pack;
718    
719    iterator= env->head;    iterator= env->head;
# Line 743  extern void pack(environment *env) Line 721  extern void pack(environment *env)
721    protect(pack);    protect(pack);
722    
723    if(iterator==NULL    if(iterator==NULL
724       || (iterator->item->type==symb       || (iterator->car->type==symb
725       && ((symbol*)(iterator->item->content.ptr))->id[0]=='[')) {       && ((symbol*)(iterator->car->content.ptr))->id[0]=='[')) {
726      temp= NULL;      temp= NULL;
727      toss(env);      toss(env);
728    } else {    } else {
729      /* Search for first delimiter */      /* Search for first delimiter */
730      while(iterator->next!=NULL      while(iterator->cdr->content.c!=NULL
731            && (iterator->next->item->type!=symb            && (iterator->cdr->content.c->car->type!=symb
732            || ((symbol*)(iterator->next->item->content.ptr))->id[0]!='['))                || ((symbol*)(iterator->cdr->content.c->car->content.ptr))->id[0]
733        iterator= iterator->next;                !='['))
734          iterator= iterator->cdr->content.c;
735            
736      /* Extract list */      /* Extract list */
737      temp= env->head;      temp= env->head;
738      env->head= iterator->next;      env->head= iterator->cdr->content.c;
739      iterator->next= NULL;      iterator->cdr->content.c= NULL;
740    
741      pack->type= list;      pack->type= tcons;
742      pack->content.ptr= temp;      pack->content.ptr= temp;
743            
744      if(env->head!=NULL)      if(env->head!=NULL)
# Line 777  extern void pack(environment *env) Line 756  extern void pack(environment *env)
756  /* Relocate elements of the list on the stack. */  /* Relocate elements of the list on the stack. */
757  extern void expand(environment *env)  extern void expand(environment *env)
758  {  {
759    stackitem *temp, *new_head;    cons *temp, *new_head;
760    
761    /* Is top element a list? */    /* Is top element a list? */
762    if(env->head==NULL) {    if(env->head==NULL) {
# Line 785  extern void expand(environment *env) Line 764  extern void expand(environment *env)
764      env->err= 1;      env->err= 1;
765      return;      return;
766    }    }
767    if(env->head->item->type!=list) {    if(env->head->car->type!=tcons) {
768      printerr("Bad Argument Type");      printerr("Bad Argument Type");
769      env->err= 2;      env->err= 2;
770      return;      return;
# Line 797  extern void expand(environment *env) Line 776  extern void expand(environment *env)
776      return;      return;
777    
778    /* The first list element is the new stack head */    /* The first list element is the new stack head */
779    new_head= temp= env->head->item->content.ptr;    new_head= temp= env->head->car->content.c;
780    
781    toss(env);    toss(env);
782    
783    /* Find the end of the list */    /* Find the end of the list */
784    while(temp->next!=NULL)    while(temp->cdr->content.ptr != NULL) {
785      temp= temp->next;      if (temp->cdr->type == tcons)
786          temp= temp->cdr->content.c;
787        else {
788          printerr("Bad Argument Type"); /* Improper list */
789          env->err= 2;
790          return;
791        }
792      }
793    
794    /* Connect the tail of the list with the old stack head */    /* Connect the tail of the list with the old stack head */
795    temp->next= env->head;    temp->cdr->content.c= env->head;
796    env->head= new_head;          /* ...and voila! */    env->head= new_head;          /* ...and voila! */
797    
798  }  }
# Line 815  extern void expand(environment *env) Line 801  extern void expand(environment *env)
801  extern void eq(environment *env)  extern void eq(environment *env)
802  {  {
803    void *left, *right;    void *left, *right;
   int result;  
804    
805    if((env->head)==NULL || env->head->next==NULL) {    if(env->head==NULL || env->head->cdr->content.c==NULL) {
806      printerr("Too Few Arguments");      printerr("Too Few Arguments");
807      env->err= 1;      env->err= 1;
808      return;      return;
809    }    }
810    
811    left= env->head->item->content.ptr;    left= env->head->car->content.ptr;
812    swap(env);    swap(env);
813    right= env->head->item->content.ptr;    right= env->head->car->content.ptr;
   result= (left==right);  
     
814    toss(env); toss(env);    toss(env); toss(env);
815    push_int(env, result);  
816      push_int(env, left==right);
817  }  }
818    
819  /* Negates the top element on the stack. */  /* Negates the top element on the stack. */
# Line 837  extern void not(environment *env) Line 821  extern void not(environment *env)
821  {  {
822    int val;    int val;
823    
824    if((env->head)==NULL) {    if(env->head==NULL) {
825      printerr("Too Few Arguments");      printerr("Too Few Arguments");
826      env->err= 1;      env->err= 1;
827      return;      return;
828    }    }
829    
830    if(env->head->item->type!=integer) {    if(env->head->car->type!=integer) {
831      printerr("Bad Argument Type");      printerr("Bad Argument Type");
832      env->err= 2;      env->err= 2;
833      return;      return;
834    }    }
835    
836    val= env->head->item->content.i;    val= env->head->car->content.i;
837    toss(env);    toss(env);
838    push_int(env, !val);    push_int(env, !val);
839  }  }
# Line 868  extern void def(environment *env) Line 852  extern void def(environment *env)
852    symbol *sym;    symbol *sym;
853    
854    /* Needs two values on the stack, the top one must be a symbol */    /* Needs two values on the stack, the top one must be a symbol */
855    if(env->head==NULL || env->head->next==NULL) {    if(env->head==NULL || env->head->cdr->content.c==NULL) {
856      printerr("Too Few Arguments");      printerr("Too Few Arguments");
857      env->err= 1;      env->err= 1;
858      return;      return;
859    }    }
860    
861    if(env->head->item->type!=symb) {    if(env->head->car->type!=symb) {
862      printerr("Bad Argument Type");      printerr("Bad Argument Type");
863      env->err= 2;      env->err= 2;
864      return;      return;
865    }    }
866    
867    /* long names are a pain */    /* long names are a pain */
868    sym= env->head->item->content.ptr;    sym= env->head->car->content.ptr;
869    
870    /* Bind the symbol to the value */    /* Bind the symbol to the value */
871    sym->val= env->head->next->item;    sym->val= env->head->cdr->content.c->car;
872    
873    toss(env); toss(env);    toss(env); toss(env);
874  }  }
# Line 953  void forget_sym(symbol **hash_entry) Line 937  void forget_sym(symbol **hash_entry)
937  extern void forget(environment *env)  extern void forget(environment *env)
938  {  {
939    char* sym_id;    char* sym_id;
940    stackitem *stack_head= env->head;    cons *stack_head= env->head;
941    
942    if(stack_head==NULL) {    if(stack_head==NULL) {
943      printerr("Too Few Arguments");      printerr("Too Few Arguments");
944      env->err=1;      env->err= 1;
945      return;      return;
946    }    }
947        
948    if(stack_head->item->type!=symb) {    if(stack_head->car->type!=symb) {
949      printerr("Bad Argument Type");      printerr("Bad Argument Type");
950      env->err=2;      env->err= 2;
951      return;      return;
952    }    }
953    
954    sym_id= ((symbol*)(stack_head->item->content.ptr))->id;    sym_id= ((symbol*)(stack_head->car->content.ptr))->id;
955    toss(env);    toss(env);
956    
957    return forget_sym(hash(env->symbols, sym_id));    return forget_sym(hash(env->symbols, sym_id));
# Line 1039  under certain conditions; type `copying; Line 1023  under certain conditions; type `copying;
1023      if (myenv.err==4) {      if (myenv.err==4) {
1024        return EXIT_SUCCESS;      /* EOF */        return EXIT_SUCCESS;      /* EOF */
1025      } else if(myenv.head!=NULL      } else if(myenv.head!=NULL
1026                && myenv.head->item->type==symb                && myenv.head->car->type==symb
1027                && ((symbol*)(myenv.head->item->content.ptr))->id[0]==';') {                && ((symbol*)(myenv.head->car->content.ptr))->id[0]==';') {
1028        toss(&myenv);             /* No error check in main */        toss(&myenv);             /* No error check in main */
1029        eval(&myenv);        eval(&myenv);
1030      }      }
# Line 1059  extern void sx_2b(environment *env) Line 1043  extern void sx_2b(environment *env)
1043    char* new_string;    char* new_string;
1044    value *a_val, *b_val;    value *a_val, *b_val;
1045    
1046    if((env->head)==NULL || env->head->next==NULL) {    if(env->head==NULL || env->head->cdr->content.c==NULL) {
1047      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1048      env->err= 1;      env->err= 1;
1049      return;      return;
1050    }    }
1051    
1052    if(env->head->item->type==string    if(env->head->car->type==string
1053       && env->head->next->item->type==string) {       && env->head->cdr->content.c->car->type==string) {
1054      a_val= env->head->item;      a_val= env->head->car;
1055      b_val= env->head->next->item;      b_val= env->head->cdr->content.c->car;
1056      protect(a_val); protect(b_val);      protect(a_val); protect(b_val);
1057      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1058      toss(env); if(env->err) return;      toss(env); if(env->err) return;
# Line 1083  extern void sx_2b(environment *env) Line 1067  extern void sx_2b(environment *env)
1067      return;      return;
1068    }    }
1069        
1070    if(env->head->item->type==integer    if(env->head->car->type==integer
1071       && env->head->next->item->type==integer) {       && env->head->cdr->content.c->car->type==integer) {
1072      a=env->head->item->content.i;      a= env->head->car->content.i;
1073      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1074      b=env->head->item->content.i;      b= env->head->car->content.i;
1075      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1076      push_int(env, b+a);      push_int(env, b+a);
1077    
1078      return;      return;
1079    }    }
1080    
1081    if(env->head->item->type==tfloat    if(env->head->car->type==tfloat
1082       && env->head->next->item->type==tfloat) {       && env->head->cdr->content.c->car->type==tfloat) {
1083      fa= env->head->item->content.f;      fa= env->head->car->content.f;
1084      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1085      fb= env->head->item->content.f;      fb= env->head->car->content.f;
1086      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1087      push_float(env, fb+fa);      push_float(env, fb+fa);
1088            
1089      return;      return;
1090    }    }
1091    
1092    if(env->head->item->type==tfloat    if(env->head->car->type==tfloat
1093       && env->head->next->item->type==integer) {       && env->head->cdr->content.c->car->type==integer) {
1094      fa= env->head->item->content.f;      fa= env->head->car->content.f;
1095      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1096      b= env->head->item->content.i;      b= env->head->car->content.i;
1097      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1098      push_float(env, b+fa);      push_float(env, b+fa);
1099            
1100      return;      return;
1101    }    }
1102    
1103    if(env->head->item->type==integer    if(env->head->car->type==integer
1104       && env->head->next->item->type==tfloat) {       && env->head->cdr->content.c->car->type==tfloat) {
1105      a= env->head->item->content.i;      a= env->head->car->content.i;
1106      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1107      fb= env->head->item->content.f;      fb= env->head->car->content.f;
1108      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1109      push_float(env, fb+a);      push_float(env, fb+a);
1110    
# Line 1137  extern void sx_2d(environment *env) Line 1121  extern void sx_2d(environment *env)
1121    int a, b;    int a, b;
1122    float fa, fb;    float fa, fb;
1123    
1124    if((env->head)==NULL || env->head->next==NULL) {    if(env->head==NULL || env->head->cdr->content.c==NULL) {
1125      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1126      env->err=1;      env->err=1;
1127      return;      return;
1128    }    }
1129        
1130    if(env->head->item->type==integer    if(env->head->car->type==integer
1131       && env->head->next->item->type==integer) {       && env->head->cdr->content.c->car->type==integer) {
1132      a=env->head->item->content.i;      a= env->head->car->content.i;
1133      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1134      b=env->head->item->content.i;      b= env->head->car->content.i;
1135      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1136      push_int(env, b-a);      push_int(env, b-a);
1137    
1138      return;      return;
1139    }    }
1140    
1141    if(env->head->item->type==tfloat    if(env->head->car->type==tfloat
1142       && env->head->next->item->type==tfloat) {       && env->head->cdr->content.c->car->type==tfloat) {
1143      fa= env->head->item->content.f;      fa= env->head->car->content.f;
1144      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1145      fb= env->head->item->content.f;      fb= env->head->car->content.f;
1146      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1147      push_float(env, fb-fa);      push_float(env, fb-fa);
1148            
1149      return;      return;
1150    }    }
1151    
1152    if(env->head->item->type==tfloat    if(env->head->car->type==tfloat
1153       && env->head->next->item->type==integer) {       && env->head->cdr->content.c->car->type==integer) {
1154      fa= env->head->item->content.f;      fa= env->head->car->content.f;
1155      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1156      b= env->head->item->content.i;      b= env->head->car->content.i;
1157      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1158      push_float(env, b-fa);      push_float(env, b-fa);
1159            
1160      return;      return;
1161    }    }
1162    
1163    if(env->head->item->type==integer    if(env->head->car->type==integer
1164       && env->head->next->item->type==tfloat) {       && env->head->cdr->content.c->car->type==tfloat) {
1165      a= env->head->item->content.i;      a= env->head->car->content.i;
1166      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1167      fb= env->head->item->content.f;      fb= env->head->car->content.f;
1168      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1169      push_float(env, fb-a);      push_float(env, fb-a);
1170    
# Line 1197  extern void sx_3e(environment *env) Line 1181  extern void sx_3e(environment *env)
1181    int a, b;    int a, b;
1182    float fa, fb;    float fa, fb;
1183    
1184    if((env->head)==NULL || env->head->next==NULL) {    if(env->head==NULL || env->head->cdr->content.c==NULL) {
1185      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1186      env->err=1;      env->err= 1;
1187      return;      return;
1188    }    }
1189        
1190    if(env->head->item->type==integer    if(env->head->car->type==integer
1191       && env->head->next->item->type==integer) {       && env->head->cdr->content.c->car->type==integer) {
1192      a=env->head->item->content.i;      a=env->head->car->content.i;
1193      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1194      b=env->head->item->content.i;      b=env->head->car->content.i;
1195      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1196      push_int(env, b>a);      push_int(env, b>a);
1197    
1198      return;      return;
1199    }    }
1200    
1201    if(env->head->item->type==tfloat    if(env->head->car->type==tfloat
1202       && env->head->next->item->type==tfloat) {       && env->head->cdr->content.c->car->type==tfloat) {
1203      fa= env->head->item->content.f;      fa= env->head->car->content.f;
1204      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1205      fb= env->head->item->content.f;      fb= env->head->car->content.f;
1206      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1207      push_int(env, fb>fa);      push_int(env, fb>fa);
1208            
1209      return;      return;
1210    }    }
1211    
1212    if(env->head->item->type==tfloat    if(env->head->car->type==tfloat
1213       && env->head->next->item->type==integer) {       && env->head->cdr->content.c->car->type==integer) {
1214      fa= env->head->item->content.f;      fa= env->head->car->content.f;
1215      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1216      b= env->head->item->content.i;      b= env->head->car->content.i;
1217      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1218      push_int(env, b>fa);      push_int(env, b>fa);
1219            
1220      return;      return;
1221    }    }
1222    
1223    if(env->head->item->type==integer    if(env->head->car->type==integer
1224       && env->head->next->item->type==tfloat) {       && env->head->cdr->content.c->car->type==tfloat) {
1225      a= env->head->item->content.i;      a= env->head->car->content.i;
1226      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1227      fb= env->head->item->content.f;      fb= env->head->car->content.f;
1228      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1229      push_int(env, fb>a);      push_int(env, fb>a);
1230    
# Line 1275  extern void sx_3e3d(environment *env) Line 1259  extern void sx_3e3d(environment *env)
1259  /* Return copy of a value */  /* Return copy of a value */
1260  value *copy_val(environment *env, value *old_value)  value *copy_val(environment *env, value *old_value)
1261  {  {
1262    stackitem *old_item, *new_item, *prev_item;    cons *old_item, *new_item, *prev_item;
1263    value *new_value;    value *new_value;
1264    
1265    protect(old_value);    protect(old_value);
# Line 1294  value *copy_val(environment *env, value Line 1278  value *copy_val(environment *env, value
1278      (char *)(new_value->content.ptr)=      (char *)(new_value->content.ptr)=
1279        strdup((char *)(old_value->content.ptr));        strdup((char *)(old_value->content.ptr));
1280      break;      break;
1281    case list:    case tcons:
1282      new_value->content.ptr= NULL;      new_value->content.ptr= NULL;
1283    
1284      prev_item= NULL;      prev_item= NULL;
1285      old_item= (stackitem*)(old_value->content.ptr);      old_item= old_value->content.c;
1286    
1287      while(old_item != NULL) {   /* While list is not empty */      if(old_value->content.ptr != NULL) { /* if list is not empty */
1288        new_item= malloc(sizeof(stackitem));        new_item= malloc(sizeof(cons));
1289        new_item->item= copy_val(env, old_item->item); /* recurse */        new_item->car= copy_val(env, old_item->car); /* recurse */
1290        new_item->next= NULL;        new_item->cdr= copy_val(env, old_item->cdr); /* recurse */
1291        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;  
     }      
1292      break;      break;
1293    }    }
1294    
# Line 1323  value *copy_val(environment *env, value Line 1300  value *copy_val(environment *env, value
1300  /* "dup"; duplicates an item on the stack */  /* "dup"; duplicates an item on the stack */
1301  extern void sx_647570(environment *env)  extern void sx_647570(environment *env)
1302  {  {
1303    if((env->head)==NULL) {    if(env->head==NULL) {
1304      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1305      env->err= 1;      env->err= 1;
1306      return;      return;
1307    }    }
1308    push_val(env, copy_val(env, env->head->item));    push_val(env, copy_val(env, env->head->car));
1309  }  }
1310    
1311  /* "if", If-Then */  /* "if", If-Then */
# Line 1336  extern void sx_6966(environment *env) Line 1313  extern void sx_6966(environment *env)
1313  {  {
1314    int truth;    int truth;
1315    
1316    if((env->head)==NULL || env->head->next==NULL) {    if(env->head==NULL || env->head->cdr->content.c==NULL) {
1317      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1318      env->err= 1;      env->err= 1;
1319      return;      return;
1320    }    }
1321    
1322    if(env->head->next->item->type != integer) {    if(env->head->cdr->content.c->car->type != integer) {
1323      printerr("Bad Argument Type");      printerr("Bad Argument Type");
1324      env->err=2;      env->err= 2;
1325      return;      return;
1326    }    }
1327        
1328    swap(env);    swap(env);
1329    if(env->err) return;    if(env->err) return;
1330        
1331    truth=env->head->item->content.i;    truth=env->head->car->content.i;
1332    
1333    toss(env);    toss(env);
1334    if(env->err) return;    if(env->err) return;
# Line 1367  extern void ifelse(environment *env) Line 1344  extern void ifelse(environment *env)
1344  {  {
1345    int truth;    int truth;
1346    
1347    if((env->head)==NULL || env->head->next==NULL    if(env->head==NULL || env->head->cdr->content.c==NULL
1348       || env->head->next->next==NULL) {       || env->head->cdr->content.c->cdr->content.c==NULL) {
1349      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1350      env->err=1;      env->err= 1;
1351      return;      return;
1352    }    }
1353    
1354    if(env->head->next->next->item->type != integer) {    if(env->head->cdr->content.c->cdr->content.c->car->type!=integer) {
1355      printerr("Bad Argument Type");      printerr("Bad Argument Type");
1356      env->err=2;      env->err= 2;
1357      return;      return;
1358    }    }
1359        
1360    rot(env);    rot(env);
1361    if(env->err) return;    if(env->err) return;
1362        
1363    truth=env->head->item->content.i;    truth= env->head->car->content.i;
1364    
1365    toss(env);    toss(env);
1366    if(env->err) return;    if(env->err) return;
# Line 1404  extern void sx_7768696c65(environment *e Line 1381  extern void sx_7768696c65(environment *e
1381    int truth;    int truth;
1382    value *loop, *test;    value *loop, *test;
1383    
1384    if((env->head)==NULL || env->head->next==NULL) {    if(env->head==NULL || env->head->cdr->content.c==NULL) {
1385      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1386      env->err=1;      env->err= 1;
1387      return;      return;
1388    }    }
1389    
1390    loop= env->head->item;    loop= env->head->car;
1391    protect(loop);    protect(loop);
1392    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1393    
1394    test= env->head->item;    test= env->head->car;
1395    protect(test);    protect(test);
1396    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1397    
# Line 1422  extern void sx_7768696c65(environment *e Line 1399  extern void sx_7768696c65(environment *e
1399      push_val(env, test);      push_val(env, test);
1400      eval(env);      eval(env);
1401            
1402      if(env->head->item->type != integer) {      if(env->head->car->type != integer) {
1403        printerr("Bad Argument Type");        printerr("Bad Argument Type");
1404        env->err= 2;        env->err= 2;
1405        return;        return;
1406      }      }
1407            
1408      truth= env->head->item->content.i;      truth= env->head->car->content.i;
1409      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1410            
1411      if(truth) {      if(truth) {
# Line 1450  extern void sx_666f72(environment *env) Line 1427  extern void sx_666f72(environment *env)
1427    value *loop;    value *loop;
1428    int foo1, foo2;    int foo1, foo2;
1429    
1430    if(env->head==NULL || env->head->next==NULL    if(env->head==NULL || env->head->cdr->content.c==NULL
1431       || env->head->next->next==NULL) {       || env->head->cdr->content.c->cdr->content.c==NULL) {
1432      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1433      env->err= 1;      env->err= 1;
1434      return;      return;
1435    }    }
1436    
1437    if(env->head->next->item->type!=integer    if(env->head->cdr->content.c->car->type!=integer
1438       || env->head->next->next->item->type!=integer) {       || env->head->cdr->content.c->cdr->content.c->car->type!=integer) {
1439      printerr("Bad Argument Type");      printerr("Bad Argument Type");
1440      env->err= 2;      env->err= 2;
1441      return;      return;
1442    }    }
1443    
1444    loop= env->head->item;    loop= env->head->car;
1445    protect(loop);    protect(loop);
1446    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1447    
1448    foo2= env->head->item->content.i;    foo2= env->head->car->content.i;
1449    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1450    
1451    foo1= env->head->item->content.i;    foo1= env->head->car->content.i;
1452    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1453    
1454    if(foo1<=foo2) {    if(foo1<=foo2) {
# Line 1496  extern void sx_666f72(environment *env) Line 1473  extern void sx_666f72(environment *env)
1473  extern void foreach(environment *env)  extern void foreach(environment *env)
1474  {    {  
1475    value *loop, *foo;    value *loop, *foo;
1476    stackitem *iterator;    cons *iterator;
1477        
1478    if((env->head)==NULL || env->head->next==NULL) {    if(env->head==NULL || env->head->cdr->content.c==NULL) {
1479      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1480      env->err= 1;      env->err= 1;
1481      return;      return;
1482    }    }
1483    
1484    if(env->head->next->item->type != list) {    if(env->head->cdr->content.c->car->type!=tcons) {
1485      printerr("Bad Argument Type");      printerr("Bad Argument Type");
1486      env->err= 2;      env->err= 2;
1487      return;      return;
1488    }    }
1489    
1490    loop= env->head->item;    loop= env->head->car;
1491    protect(loop);    protect(loop);
1492    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1493    
1494    foo= env->head->item;    foo= env->head->car;
1495    protect(foo);    protect(foo);
1496    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1497    
1498    iterator= foo->content.ptr;    iterator= foo->content.c;
1499    
1500    while(iterator!=NULL) {    while(iterator!=NULL) {
1501      push_val(env, iterator->item);      push_val(env, iterator->car);
1502      push_val(env, loop);      push_val(env, loop);
1503      eval(env); if(env->err) return;      eval(env); if(env->err) return;
1504      iterator= iterator->next;      if (iterator->cdr->type == tcons){
1505          iterator= iterator->cdr->content.c;
1506        } else {
1507          printerr("Bad Argument Type"); /* Improper list */
1508          env->err= 2;
1509          break;
1510        }
1511    }    }
1512    unprotect(loop); unprotect(foo);    unprotect(loop); unprotect(foo);
1513  }  }
# Line 1533  extern void foreach(environment *env) Line 1516  extern void foreach(environment *env)
1516  extern void to(environment *env)  extern void to(environment *env)
1517  {  {
1518    int ending, start, i;    int ending, start, i;
1519    stackitem *iterator, *temp;    cons *iterator, *temp;
1520    value *pack;    value *pack;
1521    
1522    if((env->head)==NULL || env->head->next==NULL) {    if(env->head==NULL || env->head->cdr->content.c==NULL) {
1523      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1524      env->err=1;      env->err= 1;
1525      return;      return;
1526    }    }
1527    
1528    if(env->head->item->type!=integer    if(env->head->car->type!=integer
1529       || env->head->next->item->type!=integer) {       || env->head->cdr->content.c->car->type!=integer) {
1530      printerr("Bad Argument Type");      printerr("Bad Argument Type");
1531      env->err=2;      env->err= 2;
1532      return;      return;
1533    }    }
1534    
1535    ending= env->head->item->content.i;    ending= env->head->car->content.i;
1536    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1537    start= env->head->item->content.i;    start= env->head->car->content.i;
1538    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1539    
1540    push_sym(env, "[");    push_sym(env, "[");
# Line 1569  extern void to(environment *env) Line 1552  extern void to(environment *env)
1552    protect(pack);    protect(pack);
1553    
1554    if(iterator==NULL    if(iterator==NULL
1555       || (iterator->item->type==symb       || (iterator->car->type==symb
1556       && ((symbol*)(iterator->item->content.ptr))->id[0]=='[')) {           && ((symbol*)(iterator->car->content.ptr))->id[0]=='[')) {
1557      temp= NULL;      temp= NULL;
1558      toss(env);      toss(env);
1559    } else {    } else {
1560      /* Search for first delimiter */      /* Search for first delimiter */
1561      while(iterator->next!=NULL      while(iterator->cdr->content.c!=NULL
1562            && (iterator->next->item->type!=symb            && (iterator->cdr->content.c->car->type!=symb
1563            || ((symbol*)(iterator->next->item->content.ptr))->id[0]!='['))                || ((symbol*)(iterator->cdr->content.c->car->content.ptr))->id[0]
1564        iterator= iterator->next;                !='['))
1565          iterator= iterator->cdr->content.ptr;
1566            
1567      /* Extract list */      /* Extract list */
1568      temp= env->head;      temp= env->head;
1569      env->head= iterator->next;      env->head= iterator->cdr->content.c;
1570      iterator->next= NULL;      iterator->cdr->content.c= NULL;
1571    
1572      pack->type= list;      pack->type= tcons;
1573      pack->content.ptr= temp;      pack->content.ptr= temp;
1574            
1575      if(env->head!=NULL)      if(env->head!=NULL)
# Line 1635  extern void sx_72656164(environment *env Line 1619  extern void sx_72656164(environment *env
1619      }      }
1620      readline(env); if(env->err) return;      readline(env); if(env->err) return;
1621    
1622      if(((char *)(env->head->item->content.ptr))[0]=='\0'){      if(((char *)(env->head->car->content.ptr))[0]=='\0'){
1623        env->err= 4;              /* "" means EOF */        env->err= 4;              /* "" means EOF */
1624        return;        return;
1625      }      }
1626            
1627      env->in_string= malloc(strlen(env->head->item->content.ptr)+1);      env->in_string= malloc(strlen(env->head->car->content.ptr)+1);
1628      env->free_string= env->in_string; /* Save the original pointer */      env->free_string= env->in_string; /* Save the original pointer */
1629      strcpy(env->in_string, env->head->item->content.ptr);      strcpy(env->in_string, env->head->car->content.ptr);
1630      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1631    }    }
1632        
# Line 1695  extern void beep(environment *env) Line 1679  extern void beep(environment *env)
1679  {  {
1680    int freq, dur, period, ticks;    int freq, dur, period, ticks;
1681    
1682    if((env->head)==NULL || env->head->next==NULL) {    if(env->head==NULL || env->head->cdr->content.c==NULL) {
1683      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1684      env->err=1;      env->err= 1;
1685      return;      return;
1686    }    }
1687    
1688    if(env->head->item->type!=integer    if(env->head->car->type!=integer
1689       || env->head->next->item->type!=integer) {       || env->head->cdr->content.c->car->type!=integer) {
1690      printerr("Bad Argument Type");      printerr("Bad Argument Type");
1691      env->err=2;      env->err= 2;
1692      return;      return;
1693    }    }
1694    
1695    dur=env->head->item->content.i;    dur= env->head->car->content.i;
1696    toss(env);    toss(env);
1697    freq=env->head->item->content.i;    freq= env->head->car->content.i;
1698    toss(env);    toss(env);
1699    
1700    period=1193180/freq;          /* convert freq from Hz to period    period= 1193180/freq;         /* convert freq from Hz to period
1701                                     length */                                     length */
1702    ticks=dur*.001193180;         /* convert duration from µseconds to    ticks= dur*.001193180;        /* convert duration from µseconds to
1703                                     timer ticks */                                     timer ticks */
1704    
1705  /*    ticks=dur/1000; */  /*    ticks=dur/1000; */
1706    
1707    /*  if (ioctl(STDOUT_FILENO, KDMKTONE, (125<<16) + 0x637)==0) */        /*  if (ioctl(STDOUT_FILENO, KDMKTONE, (125<<16) + 0x637)==0) */
1708    switch (ioctl(STDOUT_FILENO, KDMKTONE, (ticks<<16) | period)){    switch (ioctl(STDOUT_FILENO, KDMKTONE, (ticks<<16) | period)){
1709    case 0:    case 0:
1710      usleep(dur);      usleep(dur);
1711      return;      return;
1712    case -1:    case -1:
1713      perror("beep");      perror("beep");
1714      env->err=5;      env->err= 5;
1715      return;      return;
1716    default:    default:
1717      abort();      abort();
# Line 1739  extern void sx_77616974(environment *env Line 1723  extern void sx_77616974(environment *env
1723  {  {
1724    int dur;    int dur;
1725    
1726    if((env->head)==NULL) {    if(env->head==NULL) {
1727      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1728      env->err=1;      env->err= 1;
1729      return;      return;
1730    }    }
1731    
1732    if(env->head->item->type!=integer) {    if(env->head->car->type!=integer) {
1733      printerr("Bad Argument Type");      printerr("Bad Argument Type");
1734      env->err=2;      env->err= 2;
1735      return;      return;
1736    }    }
1737    
1738    dur=env->head->item->content.i;    dur=env->head->car->content.i;
1739    toss(env);    toss(env);
1740    
1741    usleep(dur);    usleep(dur);
# Line 2048  extern void sx_2a(environment *env) Line 2032  extern void sx_2a(environment *env)
2032    int a, b;    int a, b;
2033    float fa, fb;    float fa, fb;
2034    
2035    if((env->head)==NULL || env->head->next==NULL) {    if(env->head==NULL || env->head->cdr->content.c==NULL) {
2036      printerr("Too Few Arguments");      printerr("Too Few Arguments");
2037      env->err=1;      env->err= 1;
2038      return;      return;
2039    }    }
2040        
2041    if(env->head->item->type==integer    if(env->head->car->type==integer
2042       && env->head->next->item->type==integer) {       && env->head->cdr->content.c->car->type==integer) {
2043      a=env->head->item->content.i;      a= env->head->car->content.i;
2044      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2045      b=env->head->item->content.i;      b= env->head->car->content.i;
2046      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2047      push_int(env, b*a);      push_int(env, b*a);
2048    
2049      return;      return;
2050    }    }
2051    
2052    if(env->head->item->type==tfloat    if(env->head->car->type==tfloat
2053       && env->head->next->item->type==tfloat) {       && env->head->cdr->content.c->car->type==tfloat) {
2054      fa= env->head->item->content.f;      fa= env->head->car->content.f;
2055      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2056      fb= env->head->item->content.f;      fb= env->head->car->content.f;
2057      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2058      push_float(env, fb*fa);      push_float(env, fb*fa);
2059            
2060      return;      return;
2061    }    }
2062    
2063    if(env->head->item->type==tfloat    if(env->head->car->type==tfloat
2064       && env->head->next->item->type==integer) {       && env->head->cdr->content.c->car->type==integer) {
2065      fa= env->head->item->content.f;      fa= env->head->car->content.f;
2066      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2067      b= env->head->item->content.i;      b= env->head->car->content.i;
2068      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2069      push_float(env, b*fa);      push_float(env, b*fa);
2070            
2071      return;      return;
2072    }    }
2073    
2074    if(env->head->item->type==integer    if(env->head->car->type==integer
2075       && env->head->next->item->type==tfloat) {       && env->head->cdr->content.c->car->type==tfloat) {
2076      a= env->head->item->content.i;      a= env->head->car->content.i;
2077      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2078      fb= env->head->item->content.f;      fb= env->head->car->content.f;
2079      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2080      push_float(env, fb*a);      push_float(env, fb*a);
2081    
# Line 2099  extern void sx_2a(environment *env) Line 2083  extern void sx_2a(environment *env)
2083    }    }
2084    
2085    printerr("Bad Argument Type");    printerr("Bad Argument Type");
2086    env->err=2;    env->err= 2;
2087  }  }
2088    
2089  /* "/" */  /* "/" */
# Line 2108  extern void sx_2f(environment *env) Line 2092  extern void sx_2f(environment *env)
2092    int a, b;    int a, b;
2093    float fa, fb;    float fa, fb;
2094    
2095    if((env->head)==NULL || env->head->next==NULL) {    if(env->head==NULL || env->head->cdr->content.c==NULL) {
2096      printerr("Too Few Arguments");      printerr("Too Few Arguments");
2097      env->err=1;      env->err= 1;
2098      return;      return;
2099    }    }
2100        
2101    if(env->head->item->type==integer    if(env->head->car->type==integer
2102       && env->head->next->item->type==integer) {       && env->head->cdr->content.c->car->type==integer) {
2103      a=env->head->item->content.i;      a= env->head->car->content.i;
2104      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2105      b=env->head->item->content.i;      b= env->head->car->content.i;
2106      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2107      push_float(env, b/a);      push_float(env, b/a);
2108    
2109      return;      return;
2110    }    }
2111    
2112    if(env->head->item->type==tfloat    if(env->head->car->type==tfloat
2113       && env->head->next->item->type==tfloat) {       && env->head->cdr->content.c->car->type==tfloat) {
2114      fa= env->head->item->content.f;      fa= env->head->car->content.f;
2115      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2116      fb= env->head->item->content.f;      fb= env->head->car->content.f;
2117      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2118      push_float(env, fb/fa);      push_float(env, fb/fa);
2119            
2120      return;      return;
2121    }    }
2122    
2123    if(env->head->item->type==tfloat    if(env->head->car->type==tfloat
2124       && env->head->next->item->type==integer) {       && env->head->cdr->content.c->car->type==integer) {
2125      fa= env->head->item->content.f;      fa= env->head->car->content.f;
2126      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2127      b= env->head->item->content.i;      b= env->head->car->content.i;
2128      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2129      push_float(env, b/fa);      push_float(env, b/fa);
2130            
2131      return;      return;
2132    }    }
2133    
2134    if(env->head->item->type==integer    if(env->head->car->type==integer
2135       && env->head->next->item->type==tfloat) {       && env->head->cdr->content.c->car->type==tfloat) {
2136      a= env->head->item->content.i;      a= env->head->car->content.i;
2137      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2138      fb= env->head->item->content.f;      fb= env->head->car->content.f;
2139      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2140      push_float(env, fb/a);      push_float(env, fb/a);
2141    
# Line 2159  extern void sx_2f(environment *env) Line 2143  extern void sx_2f(environment *env)
2143    }    }
2144    
2145    printerr("Bad Argument Type");    printerr("Bad Argument Type");
2146    env->err=2;    env->err= 2;
2147  }  }
2148    
2149  /* "mod" */  /* "mod" */
# Line 2167  extern void mod(environment *env) Line 2151  extern void mod(environment *env)
2151  {  {
2152    int a, b;    int a, b;
2153    
2154    if((env->head)==NULL || env->head->next==NULL) {    if(env->head==NULL || env->head->cdr->content.c==NULL) {
2155      printerr("Too Few Arguments");      printerr("Too Few Arguments");
2156      env->err= 1;      env->err= 1;
2157      return;      return;
2158    }    }
2159        
2160    if(env->head->item->type==integer    if(env->head->car->type==integer
2161       && env->head->next->item->type==integer) {       && env->head->cdr->content.c->car->type==integer) {
2162      a= env->head->item->content.i;      a= env->head->car->content.i;
2163      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2164      b= env->head->item->content.i;      b= env->head->car->content.i;
2165      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2166      push_int(env, b%a);      push_int(env, b%a);
2167    
# Line 2185  extern void mod(environment *env) Line 2169  extern void mod(environment *env)
2169    }    }
2170    
2171    printerr("Bad Argument Type");    printerr("Bad Argument Type");
2172    env->err=2;    env->err= 2;
2173  }  }
2174    
2175  /* "div" */  /* "div" */
# Line 2193  extern void sx_646976(environment *env) Line 2177  extern void sx_646976(environment *env)
2177  {  {
2178    int a, b;    int a, b;
2179        
2180    if((env->head)==NULL || env->head->next==NULL) {    if(env->head==NULL || env->head->cdr->content.c==NULL) {
2181      printerr("Too Few Arguments");      printerr("Too Few Arguments");
2182      env->err= 1;      env->err= 1;
2183      return;      return;
2184    }    }
2185    
2186    if(env->head->item->type==integer    if(env->head->car->type==integer
2187       && env->head->next->item->type==integer) {       && env->head->cdr->content.c->car->type==integer) {
2188      a= env->head->item->content.i;      a= env->head->car->content.i;
2189      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2190      b= env->head->item->content.i;      b= env->head->car->content.i;
2191      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2192      push_int(env, (int)b/a);      push_int(env, (int)b/a);
2193    
Legend:
Removed from v.1.101  
changed lines
  Added in v.1.103
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26