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

Diff of /stack/stack.c

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

revision 1.99 by teddy, Sun Mar 10 10:06:36 2002 UTC revision 1.111 by teddy, Sat Mar 16 19:09:54 2002 UTC
# Line 20  Line 20 
20               Teddy Hogeborn <teddy@fukt.bth.se>               Teddy Hogeborn <teddy@fukt.bth.se>
21  */  */
22    
23    #define CAR(X) X->content.c->car
24    #define CDR(X) X->content.c->cdr
25    
26  /* printf, sscanf, fgets, fprintf, fopen, perror */  /* printf, sscanf, fgets, fprintf, fopen, perror */
27  #include <stdio.h>  #include <stdio.h>
28  /* exit, EXIT_SUCCESS, malloc, free */  /* exit, EXIT_SUCCESS, malloc, free */
# Line 34  Line 37 
37  #include <unistd.h>  #include <unistd.h>
38  /* EX_NOINPUT, EX_USAGE */  /* EX_NOINPUT, EX_USAGE */
39  #include <sysexits.h>  #include <sysexits.h>
40    /* assert */
41    #include <assert.h>
42    
43    #ifdef __linux__
44  /* mtrace, muntrace */  /* mtrace, muntrace */
45  #include <mcheck.h>  #include <mcheck.h>
46  /* ioctl */  /* ioctl */
47  #include <sys/ioctl.h>  #include <sys/ioctl.h>
48  /* KDMKTONE */  /* KDMKTONE */
49  #include <linux/kd.h>  #include <linux/kd.h>
50    #endif /* __linux__ */
51    
52  #include "stack.h"  #include "stack.h"
53    
# Line 48  void init_env(environment *env) Line 56  void init_env(environment *env)
56  {  {
57    int i;    int i;
58    
59    env->gc_limit= 200;    env->gc_limit= 400000;
60    env->gc_count= 0;    env->gc_count= 0;
61    env->gc_ref= NULL;    env->gc_ref= NULL;
62    
63    env->head= NULL;    env->head= new_val(env);
64      env->head->type= empty;
65    for(i= 0; i<HASHTBLSIZE; i++)    for(i= 0; i<HASHTBLSIZE; i++)
66      env->symbols[i]= NULL;      env->symbols[i]= NULL;
67    env->err= 0;    env->err= 0;
# Line 70  void printerr(const char* in_string) Line 79  void printerr(const char* in_string)
79  /* Discard the top element of the stack. */  /* Discard the top element of the stack. */
80  extern void toss(environment *env)  extern void toss(environment *env)
81  {  {
82    stackitem *temp= env->head;    if(env->head->type==empty) {
   
   if((env->head)==NULL) {  
83      printerr("Too Few Arguments");      printerr("Too Few Arguments");
84      env->err= 1;      env->err= 1;
85      return;      return;
86    }    }
87        
88    env->head= env->head->next;   /* Remove the top stack item */    env->head= CDR(env->head); /* Remove the top stack item */
   free(temp);                   /* Free the old top stack item */  
   
   env->gc_limit--;  
89  }  }
90    
91  /* Returns a pointer to a pointer to an element in the hash table. */  /* Returns a pointer to a pointer to an element in the hash table. */
# Line 120  value* new_val(environment *env) Line 124  value* new_val(environment *env)
124    stackitem *nitem= malloc(sizeof(stackitem));    stackitem *nitem= malloc(sizeof(stackitem));
125    
126    nval->content.ptr= NULL;    nval->content.ptr= NULL;
127      nval->type= integer;
128    
129    nitem->item= nval;    nitem->item= nval;
130    nitem->next= env->gc_ref;    nitem->next= env->gc_ref;
131    
132    env->gc_ref= nitem;    env->gc_ref= nitem;
133    
134    env->gc_count++;    env->gc_count += sizeof(value);
135    nval->gc.flag.mark= 0;    nval->gc.flag.mark= 0;
136    nval->gc.flag.protect= 0;    nval->gc.flag.protect= 0;
137    
# Line 136  value* new_val(environment *env) Line 142  value* new_val(environment *env)
142     Marked values are not collected by the GC. */     Marked values are not collected by the GC. */
143  inline void gc_mark(value *val)  inline void gc_mark(value *val)
144  {  {
145    stackitem *iterator;    if(val==NULL || val->gc.flag.mark)
   
   if(val->gc.flag.mark)  
146      return;      return;
147    
148    val->gc.flag.mark= 1;    val->gc.flag.mark= 1;
149    
150    if(val->type==list) {    if(val->type==tcons) {
151      iterator= val->content.ptr;      gc_mark(CAR(val));
152        gc_mark(CDR(val));
     while(iterator!=NULL) {  
       gc_mark(iterator->item);  
       iterator= iterator->next;  
     }  
153    }    }
154  }  }
155    
# Line 164  inline void gc_maybe(environment *env) Line 164  inline void gc_maybe(environment *env)
164  /* Start GC */  /* Start GC */
165  extern void gc_init(environment *env)  extern void gc_init(environment *env)
166  {  {
167    stackitem *new_head= NULL, *titem, *iterator;    stackitem *new_head= NULL, *titem;
168      cons *iterator;
169    symbol *tsymb;    symbol *tsymb;
170    int i;    int i;
171    
172      if(env->interactive)
173        printf("Garbage collecting.");
174    
175    /* Mark values on stack */    /* Mark values on stack */
176    iterator= env->head;    gc_mark(env->head);
177    while(iterator!=NULL) {  
178      gc_mark(iterator->item);    if(env->interactive)
179      iterator= iterator->next;      printf(".");
180    }  
181    
182    /* Mark values in hashtable */    /* Mark values in hashtable */
183    for(i= 0; i<HASHTBLSIZE; i++) {    for(i= 0; i<HASHTBLSIZE; i++)
184      tsymb= env->symbols[i];      for(tsymb= env->symbols[i]; tsymb!=NULL; tsymb= tsymb->next)
     while(tsymb!=NULL) {  
185        if (tsymb->val != NULL)        if (tsymb->val != NULL)
186          gc_mark(tsymb->val);          gc_mark(tsymb->val);
187        tsymb= tsymb->next;  
188      }  
189    }    if(env->interactive)
190        printf(".");
191    
192    env->gc_count= 0;    env->gc_count= 0;
193    
# Line 191  extern void gc_init(environment *env) Line 195  extern void gc_init(environment *env)
195    
196      if(!(env->gc_ref->item->gc.no_gc)){ /* neither mark nor protect */      if(!(env->gc_ref->item->gc.no_gc)){ /* neither mark nor protect */
197    
198        switch(env->gc_ref->item->type) { /* Remove content */        if(env->gc_ref->item->type==string) /* Remove content */
       case string:  
199          free(env->gc_ref->item->content.ptr);          free(env->gc_ref->item->content.ptr);
200          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:  
       }  
201        free(env->gc_ref->item);  /* Remove from gc_ref */        free(env->gc_ref->item);  /* Remove from gc_ref */
202        titem= env->gc_ref->next;        titem= env->gc_ref->next;
203        free(env->gc_ref);        /* Remove value */        free(env->gc_ref);        /* Remove value */
204        env->gc_ref= titem;        env->gc_ref= titem;
205        continue;        continue;
206      }      }
207    #ifdef DEBUG
208        printf("Kept value (%p)", env->gc_ref->item);
209        if(env->gc_ref->item->gc.flag.mark)
210          printf(" (marked)");
211        if(env->gc_ref->item->gc.flag.protect)
212          printf(" (protected)");
213        switch(env->gc_ref->item->type){
214        case integer:
215          printf(" integer: %d", env->gc_ref->item->content.i);
216          break;
217        case func:
218          printf(" func: %p", env->gc_ref->item->content.ptr);
219          break;
220        case symb:
221          printf(" symb: %s", env->gc_ref->item->content.sym->id);
222          break;
223        case tcons:
224          printf(" tcons: %p\t%p", env->gc_ref->item->content.c->car,
225                 env->gc_ref->item->content.c->cdr);
226          break;
227        default:
228          printf(" <unknown %d>", (env->gc_ref->item->type));
229        }
230        printf("\n");
231    #endif /* DEBUG */
232    
233        /* Keep values */    
234        env->gc_count += sizeof(value);
235        if(env->gc_ref->item->type==string)
236          env->gc_count += strlen(env->gc_ref->item->content.ptr);
237            
     /* Keep values */  
238      titem= env->gc_ref->next;      titem= env->gc_ref->next;
239      env->gc_ref->next= new_head;      env->gc_ref->next= new_head;
240      new_head= env->gc_ref;      new_head= env->gc_ref;
241      new_head->item->gc.flag.mark= 0;      new_head->item->gc.flag.mark= 0;
242      env->gc_ref= titem;      env->gc_ref= titem;
     env->gc_count++;  
243    }    }
244    
245    env->gc_limit= env->gc_count*2;    if (env->gc_limit < env->gc_count*2)
246        env->gc_limit= env->gc_count*2;
247    
248    env->gc_ref= new_head;    env->gc_ref= new_head;
249    
250      if(env->interactive)
251        printf("done (%d bytes still allocated)\n", env->gc_count);
252    
253  }  }
254    
255  /* Protect values from GC */  /* Protect values from GC */
256  void protect(value *val)  void protect(value *val)
257  {  {
258    stackitem *iterator;    if(val==NULL || val->gc.flag.protect)
   
   if(val->gc.flag.protect)  
259      return;      return;
260    
261    val->gc.flag.protect= 1;    val->gc.flag.protect= 1;
262    
263    if(val->type==list) {    if(val->type==tcons) {
264      iterator= val->content.ptr;      protect(CAR(val));
265        protect(CDR(val));
     while(iterator!=NULL) {  
       protect(iterator->item);  
       iterator= iterator->next;  
     }  
266    }    }
267  }  }
268    
269  /* Unprotect values from GC */  /* Unprotect values from GC */
270  void unprotect(value *val)  void unprotect(value *val)
271  {  {
272    stackitem *iterator;    if(val==NULL || !(val->gc.flag.protect))
   
   if(!(val->gc.flag.protect))  
273      return;      return;
274    
275    val->gc.flag.protect= 0;    val->gc.flag.protect= 0;
276    
277    if(val->type==list) {    if(val->type==tcons) {
278      iterator= val->content.ptr;      unprotect(CAR(val));
279        unprotect(CDR(val));
     while(iterator!=NULL) {  
       unprotect(iterator->item);  
       iterator= iterator->next;  
     }  
280    }    }
281  }  }
282    
283  /* Push a value onto the stack */  /* Push a value onto the stack */
284  void push_val(environment *env, value *val)  void push_val(environment *env, value *val)
285  {  {
286    stackitem *new_item= malloc(sizeof(stackitem));    value *new_value= new_val(env);
287    new_item->item= val;  
288    new_item->next= env->head;    new_value->content.c= malloc(sizeof(cons));
289    env->head= new_item;    assert(new_value->content.c!=NULL);
290      new_value->type= tcons;
291      CAR(new_value)= val;
292      CDR(new_value)= env->head;
293      env->head= new_value;
294  }  }
295    
296  /* Push an integer onto the stack */  /* Push an integer onto the stack */
# Line 298  void push_float(environment *env, float Line 319  void push_float(environment *env, float
319  void push_cstring(environment *env, const char *in_string)  void push_cstring(environment *env, const char *in_string)
320  {  {
321    value *new_value= new_val(env);    value *new_value= new_val(env);
322      int length= strlen(in_string)+1;
323    
324    new_value->content.ptr= malloc(strlen(in_string)+1);    new_value->content.ptr= malloc(length);
325      env->gc_count += length;
326    strcpy(new_value->content.ptr, in_string);    strcpy(new_value->content.ptr, in_string);
327    new_value->type= string;    new_value->type= string;
328    
# Line 330  extern void mangle(environment *env) Line 353  extern void mangle(environment *env)
353  {  {
354    char *new_string;    char *new_string;
355    
356    if((env->head)==NULL) {    if(env->head->type==empty) {
357      printerr("Too Few Arguments");      printerr("Too Few Arguments");
358      env->err= 1;      env->err= 1;
359      return;      return;
360    }    }
361    
362    if(env->head->item->type!=string) {    if(CAR(env->head)->type!=string) {
363      printerr("Bad Argument Type");      printerr("Bad Argument Type");
364      env->err= 2;      env->err= 2;
365      return;      return;
366    }    }
367    
368    new_string= mangle_str((const char *)(env->head->item->content.ptr));    new_string=
369        mangle_str((const char *)(CAR(env->head)->content.ptr));
370    
371    toss(env);    toss(env);
372    if(env->err) return;    if(env->err) return;
# Line 428  extern void type(environment *env) Line 452  extern void type(environment *env)
452  {  {
453    int typenum;    int typenum;
454    
455    if((env->head)==NULL) {    if(env->head->type==empty) {
456      printerr("Too Few Arguments");      printerr("Too Few Arguments");
457      env->err=1;      env->err= 1;
458      return;      return;
459    }    }
460    typenum=env->head->item->type;  
461      typenum= CAR(env->head)->type;
462    toss(env);    toss(env);
463    switch(typenum){    switch(typenum){
464    case integer:    case integer:
# Line 451  extern void type(environment *env) Line 476  extern void type(environment *env)
476    case func:    case func:
477      push_sym(env, "function");      push_sym(env, "function");
478      break;      break;
479    case list:    case tcons:
480      push_sym(env, "list");      push_sym(env, "list");
481      break;      break;
482    }    }
483  }      }    
484    
485  /* Prints the top element of the stack. */  /* Prints the top element of the stack. */
486  void print_h(stackitem *stack_head, int noquote)  void print_h(value *stack_head, int noquote)
487  {  {
488    switch(stack_head->item->type) {    switch(CAR(stack_head)->type) {
489    case integer:    case integer:
490      printf("%d", stack_head->item->content.i);      printf("%d", CAR(stack_head)->content.i);
491      break;      break;
492    case tfloat:    case tfloat:
493      printf("%f", stack_head->item->content.f);      printf("%f", CAR(stack_head)->content.f);
494      break;      break;
495    case string:    case string:
496      if(noquote)      if(noquote)
497        printf("%s", (char*)stack_head->item->content.ptr);        printf("%s", (char*)CAR(stack_head)->content.ptr);
498      else      else
499        printf("\"%s\"", (char*)stack_head->item->content.ptr);        printf("\"%s\"", (char*)CAR(stack_head)->content.ptr);
500      break;      break;
501    case symb:    case symb:
502      printf("%s", ((symbol *)(stack_head->item->content.ptr))->id);      printf("%s", CAR(stack_head)->content.sym->id);
503      break;      break;
504    case func:    case func:
505      printf("#<function %p>", (funcp)(stack_head->item->content.ptr));      printf("#<function %p>", (funcp)(CAR(stack_head)->content.ptr));
506      break;      break;
507    case list:    case tcons:
508      /* 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 */
509      stack_head=(stackitem *)(stack_head->item->content.ptr);      stack_head= CAR(stack_head);
510      printf("[ ");      printf("[ ");
511      while(stack_head != NULL) {      while(CAR(stack_head)->type != empty) {
512        print_h(stack_head, noquote);        print_h(stack_head, noquote);
513        printf(" ");        if(CDR(stack_head)->type==tcons)
514        stack_head=stack_head->next;          printf(" ");
515          else
516            printf(" . ");          /* Improper list */
517          stack_head= CDR(stack_head);
518      }      }
519      printf("]");      printf(" ]");
520      break;      break;
521    }    }
522  }  }
523    
524  extern void print_(environment *env)  extern void print_(environment *env)
525  {  {
526    if(env->head==NULL) {    if(env->head->type==empty) {
527      printerr("Too Few Arguments");      printerr("Too Few Arguments");
528      env->err=1;      env->err= 1;
529      return;      return;
530    }    }
531    print_h(env->head, 0);    print_h(env->head, 0);
# Line 514  extern void print(environment *env) Line 542  extern void print(environment *env)
542    
543  extern void princ_(environment *env)  extern void princ_(environment *env)
544  {  {
545    if(env->head==NULL) {    if(env->head->type==empty) {
546      printerr("Too Few Arguments");      printerr("Too Few Arguments");
547      env->err=1;      env->err= 1;
548      return;      return;
549    }    }
550    print_h(env->head, 1);    print_h(env->head, 1);
# Line 531  extern void princ(environment *env) Line 559  extern void princ(environment *env)
559  }  }
560    
561  /* Only to be called by function printstack. */  /* Only to be called by function printstack. */
562  void print_st(stackitem *stack_head, long counter)  void print_st(value *stack_head, long counter)
563  {  {
564    if(stack_head->next != NULL)    if(CDR(stack_head)->type != empty)
565      print_st(stack_head->next, counter+1);      print_st(CDR(stack_head), counter+1);
566    printf("%ld: ", counter);    printf("%ld: ", counter);
567    print_h(stack_head, 0);    print_h(stack_head, 0);
568    nl();    nl();
# Line 543  void print_st(stackitem *stack_head, lon Line 571  void print_st(stackitem *stack_head, lon
571  /* Prints the stack. */  /* Prints the stack. */
572  extern void printstack(environment *env)  extern void printstack(environment *env)
573  {  {
574    if(env->head == NULL) {    if(env->head->type == empty) {
575      printf("Stack Empty\n");      printf("Stack Empty\n");
576      return;      return;
577    }    }
# Line 554  extern void printstack(environment *env) Line 582  extern void printstack(environment *env)
582  /* Swap the two top elements on the stack. */  /* Swap the two top elements on the stack. */
583  extern void swap(environment *env)  extern void swap(environment *env)
584  {  {
585    stackitem *temp= env->head;    value *temp= env->head;
586        
587    if(env->head==NULL || env->head->next==NULL) {    if(env->head->type == empty || CDR(env->head)->type == empty) {
588      printerr("Too Few Arguments");      printerr("Too Few Arguments");
589      env->err=1;      env->err=1;
590      return;      return;
591    }    }
592    
593    env->head= env->head->next;    env->head= CDR(env->head);
594    temp->next= env->head->next;    CDR(temp)= CDR(env->head);
595    env->head->next= temp;    CDR(env->head)= temp;
596  }  }
597    
598  /* Rotate the first three elements on the stack. */  /* Rotate the first three elements on the stack. */
599  extern void rot(environment *env)  extern void rot(environment *env)
600  {  {
601    stackitem *temp= env->head;    value *temp= env->head;
602        
603    if(env->head==NULL || env->head->next==NULL    if(env->head->type == empty || CDR(env->head)->type == empty
604        || env->head->next->next==NULL) {       || CDR(CDR(env->head))->type == empty) {
605      printerr("Too Few Arguments");      printerr("Too Few Arguments");
606      env->err=1;      env->err= 1;
607      return;      return;
608    }    }
609      
610    env->head= env->head->next->next;    env->head= CDR(CDR(env->head));
611    temp->next->next= env->head->next;    CDR(CDR(temp))= CDR(env->head);
612    env->head->next= temp;    CDR(env->head)= temp;
613  }  }
614    
615  /* Recall a value from a symbol, if bound */  /* Recall a value from a symbol, if bound */
# Line 589  extern void rcl(environment *env) Line 617  extern void rcl(environment *env)
617  {  {
618    value *val;    value *val;
619    
620    if(env->head == NULL) {    if(env->head->type==empty) {
621      printerr("Too Few Arguments");      printerr("Too Few Arguments");
622      env->err=1;      env->err= 1;
623      return;      return;
624    }    }
625    
626    if(env->head->item->type!=symb) {    if(CAR(env->head)->type!=symb) {
627      printerr("Bad Argument Type");      printerr("Bad Argument Type");
628      env->err=2;      env->err= 2;
629      return;      return;
630    }    }
631    
632    val=((symbol *)(env->head->item->content.ptr))->val;    val= CAR(env->head)->content.sym->val;
633    if(val == NULL){    if(val == NULL){
634      printerr("Unbound Variable");      printerr("Unbound Variable");
635      env->err=3;      env->err= 3;
636      return;      return;
637    }    }
638    protect(val);    push_val(env, val);           /* Return the symbol's bound value */
639    toss(env);            /* toss the symbol */    swap(env);
640      if(env->err) return;
641      toss(env);                    /* toss the symbol */
642    if(env->err) return;    if(env->err) return;
   push_val(env, val); /* Return its bound value */  
   unprotect(val);  
643  }  }
644    
645  /* If the top element is a symbol, determine if it's bound to a  /* If the top element is a symbol, determine if it's bound to a
# Line 621  extern void eval(environment *env) Line 649  extern void eval(environment *env)
649  {  {
650    funcp in_func;    funcp in_func;
651    value* temp_val;    value* temp_val;
652    stackitem* iterator;    value* iterator;
653    
654   eval_start:   eval_start:
655    
656    gc_maybe(env);    gc_maybe(env);
657    
658    if(env->head==NULL) {    if(env->head->type==empty) {
659      printerr("Too Few Arguments");      printerr("Too Few Arguments");
660      env->err=1;      env->err= 1;
661      return;      return;
662    }    }
663    
664    switch(env->head->item->type) {    switch(CAR(env->head)->type) {
665      /* if it's a symbol */      /* if it's a symbol */
666    case symb:    case symb:
667      rcl(env);                   /* get its contents */      rcl(env);                   /* get its contents */
668      if(env->err) return;      if(env->err) return;
669      if(env->head->item->type!=symb){ /* don't recurse symbols */      if(CAR(env->head)->type!=symb){ /* don't recurse symbols */
670        goto eval_start;        goto eval_start;
671      }      }
672      return;      return;
673    
674      /* If it's a lone function value, run it */      /* If it's a lone function value, run it */
675    case func:    case func:
676      in_func= (funcp)(env->head->item->content.ptr);      in_func= (funcp)(CAR(env->head)->content.ptr);
677      toss(env);      toss(env);
678      if(env->err) return;      if(env->err) return;
679      return in_func(env);      return in_func(env);
680    
681      /* If it's a list */      /* If it's a list */
682    case list:    case tcons:
683      temp_val= env->head->item;      temp_val= CAR(env->head);
684      protect(temp_val);      protect(temp_val);
685    
686      toss(env); if(env->err) return;      toss(env); if(env->err) return;
687      iterator= (stackitem*)temp_val->content.ptr;      iterator= temp_val;
688            
689      while(iterator!=NULL) {      while(iterator->type != empty) {
690        push_val(env, iterator->item);        push_val(env, CAR(iterator));
691                
692        if(env->head->item->type==symb        if(CAR(env->head)->type==symb
693          && strcmp(";", ((symbol*)(env->head->item->content.ptr))->id)==0) {           && CAR(env->head)->content.sym->id[0]==';') {
694          toss(env);          toss(env);
695          if(env->err) return;          if(env->err) return;
696                    
697          if(iterator->next == NULL){          if(CDR(iterator)->type == empty){
698            goto eval_start;            goto eval_start;
699          }          }
700          eval(env);          eval(env);
701          if(env->err) return;          if(env->err) return;
702        }        }
703        iterator= iterator->next;        if (CDR(iterator)->type == empty || CDR(iterator)->type == tcons)
704            iterator= CDR(iterator);
705          else {
706            printerr("Bad Argument Type"); /* Improper list */
707            env->err= 2;
708            return;
709          }
710      }      }
711      unprotect(temp_val);      unprotect(temp_val);
712      return;      return;
# Line 685  extern void eval(environment *env) Line 719  extern void eval(environment *env)
719  /* Reverse (flip) a list */  /* Reverse (flip) a list */
720  extern void rev(environment *env)  extern void rev(environment *env)
721  {  {
722    stackitem *old_head, *new_head, *item;    value *old_head, *new_head, *item;
723    
724    if((env->head)==NULL) {    if(env->head->type==empty) {
725      printerr("Too Few Arguments");      printerr("Too Few Arguments");
726      env->err= 1;      env->err= 1;
727      return;      return;
728    }    }
729    
730    if(env->head->item->type!=list) {    if(CAR(env->head)->type==empty)
731        return;                     /* Don't reverse an empty list */
732    
733      if(CAR(env->head)->type!=tcons) {
734      printerr("Bad Argument Type");      printerr("Bad Argument Type");
735      env->err= 2;      env->err= 2;
736      return;      return;
737    }    }
738    
739    old_head= (stackitem *)(env->head->item->content.ptr);    old_head= CAR(env->head);
740    new_head= NULL;    new_head= new_val(env);
741    while(old_head != NULL){    new_head->type= empty;
742      while(old_head->type != empty) {
743      item= old_head;      item= old_head;
744      old_head= old_head->next;      old_head= CDR(old_head);
745      item->next= new_head;      CDR(item)= new_head;
746      new_head= item;      new_head= item;
747    }    }
748    env->head->item->content.ptr= new_head;    CAR(env->head)= new_head;
749  }  }
750    
751  /* Make a list. */  /* Make a list. */
752  extern void pack(environment *env)  extern void pack(environment *env)
753  {  {
754    stackitem *iterator, *temp;    value *iterator, *temp, *ending;
   value *pack;  
755    
756    iterator= env->head;    ending=new_val(env);
757    pack= new_val(env);    ending->type=empty;
   protect(pack);  
758    
759    if(iterator==NULL    iterator= env->head;
760       || (iterator->item->type==symb    if(iterator->type == empty
761       && ((symbol*)(iterator->item->content.ptr))->id[0]=='[')) {       || (CAR(iterator)->type==symb
762      temp= NULL;       && CAR(iterator)->content.sym->id[0]=='[')) {
763        temp= ending;
764      toss(env);      toss(env);
765    } else {    } else {
766      /* Search for first delimiter */      /* Search for first delimiter */
767      while(iterator->next!=NULL      while(CDR(iterator)->type != empty
768            && (iterator->next->item->type!=symb            && (CAR(CDR(iterator))->type!=symb
769            || ((symbol*)(iterator->next->item->content.ptr))->id[0]!='['))             || CAR(CDR(iterator))->content.sym->id[0]!='['))
770        iterator= iterator->next;        iterator= CDR(iterator);
771            
772      /* Extract list */      /* Extract list */
773      temp= env->head;      temp= env->head;
774      env->head= iterator->next;      env->head= CDR(iterator);
775      iterator->next= NULL;      CDR(iterator)= ending;
776    
777      pack->type= list;      if(env->head->type != empty)
     pack->content.ptr= temp;  
       
     if(env->head!=NULL)  
778        toss(env);        toss(env);
779    }    }
780    
781    /* Push list */    /* Push list */
782    
783    push_val(env, pack);    push_val(env, temp);
784    rev(env);    rev(env);
   
   unprotect(pack);  
785  }  }
786    
787  /* Relocate elements of the list on the stack. */  /* Relocate elements of the list on the stack. */
788  extern void expand(environment *env)  extern void expand(environment *env)
789  {  {
790    stackitem *temp, *new_head;    value *temp, *new_head;
791    
792    /* Is top element a list? */    /* Is top element a list? */
793    if(env->head==NULL) {    if(env->head->type==empty) {
794      printerr("Too Few Arguments");      printerr("Too Few Arguments");
795      env->err= 1;      env->err= 1;
796      return;      return;
797    }    }
798    if(env->head->item->type!=list) {  
799      if(CAR(env->head)->type!=tcons) {
800      printerr("Bad Argument Type");      printerr("Bad Argument Type");
801      env->err= 2;      env->err= 2;
802      return;      return;
# Line 775  extern void expand(environment *env) Line 808  extern void expand(environment *env)
808      return;      return;
809    
810    /* The first list element is the new stack head */    /* The first list element is the new stack head */
811    new_head= temp= env->head->item->content.ptr;    new_head= temp= CAR(env->head);
812    
813    toss(env);    toss(env);
814    
815    /* Find the end of the list */    /* Find the end of the list */
816    while(temp->next!=NULL)    while(CDR(temp)->type != empty) {
817      temp= temp->next;      if (CDR(temp)->type == tcons)
818          temp= CDR(temp);
819        else {
820          printerr("Bad Argument Type"); /* Improper list */
821          env->err= 2;
822          return;
823        }
824      }
825    
826    /* Connect the tail of the list with the old stack head */    /* Connect the tail of the list with the old stack head */
827    temp->next= env->head;    CDR(temp)= env->head;
828    env->head= new_head;          /* ...and voila! */    env->head= new_head;          /* ...and voila! */
829    
830  }  }
# Line 793  extern void expand(environment *env) Line 833  extern void expand(environment *env)
833  extern void eq(environment *env)  extern void eq(environment *env)
834  {  {
835    void *left, *right;    void *left, *right;
   int result;  
836    
837    if((env->head)==NULL || env->head->next==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
838      printerr("Too Few Arguments");      printerr("Too Few Arguments");
839      env->err= 1;      env->err= 1;
840      return;      return;
841    }    }
842    
843    left= env->head->item->content.ptr;    left= CAR(env->head)->content.ptr;
844    swap(env);    right= CAR(CDR(env->head))->content.ptr;
   right= env->head->item->content.ptr;  
   result= (left==right);  
     
845    toss(env); toss(env);    toss(env); toss(env);
846    push_int(env, result);  
847      push_int(env, left==right);
848  }  }
849    
850  /* Negates the top element on the stack. */  /* Negates the top element on the stack. */
# Line 815  extern void not(environment *env) Line 852  extern void not(environment *env)
852  {  {
853    int val;    int val;
854    
855    if((env->head)==NULL) {    if(env->head->type==empty) {
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!=integer) {    if(CAR(env->head)->type!=integer) {
862      printerr("Bad Argument Type");      printerr("Bad Argument Type");
863      env->err= 2;      env->err= 2;
864      return;      return;
865    }    }
866    
867    val= env->head->item->content.i;    val= CAR(env->head)->content.i;
868    toss(env);    toss(env);
869    push_int(env, !val);    push_int(env, !val);
870  }  }
# Line 846  extern void def(environment *env) Line 883  extern void def(environment *env)
883    symbol *sym;    symbol *sym;
884    
885    /* 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 */
886    if(env->head==NULL || env->head->next==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
887      printerr("Too Few Arguments");      printerr("Too Few Arguments");
888      env->err= 1;      env->err= 1;
889      return;      return;
890    }    }
891    
892    if(env->head->item->type!=symb) {    if(CAR(env->head)->type!=symb) {
893      printerr("Bad Argument Type");      printerr("Bad Argument Type");
894      env->err= 2;      env->err= 2;
895      return;      return;
896    }    }
897    
898    /* long names are a pain */    /* long names are a pain */
899    sym= env->head->item->content.ptr;    sym= CAR(env->head)->content.ptr;
900    
901    /* Bind the symbol to the value */    /* Bind the symbol to the value */
902    sym->val= env->head->next->item;    sym->val= CAR(CDR(env->head));
903    
904    toss(env); toss(env);    toss(env); toss(env);
905  }  }
# Line 885  extern void quit(environment *env) Line 922  extern void quit(environment *env)
922    env->gc_limit= 0;    env->gc_limit= 0;
923    gc_maybe(env);    gc_maybe(env);
924    
925      words(env);
926    
927    if(env->free_string!=NULL)    if(env->free_string!=NULL)
928      free(env->free_string);      free(env->free_string);
929        
930    #ifdef __linux__
931    muntrace();    muntrace();
932    #endif
933    
934    exit(EXIT_SUCCESS);    exit(EXIT_SUCCESS);
935  }  }
# Line 896  extern void quit(environment *env) Line 937  extern void quit(environment *env)
937  /* Clear stack */  /* Clear stack */
938  extern void clear(environment *env)  extern void clear(environment *env)
939  {  {
940    while(env->head!=NULL)    while(env->head->type != empty)
941      toss(env);      toss(env);
942  }  }
943    
# Line 909  extern void words(environment *env) Line 950  extern void words(environment *env)
950    for(i= 0; i<HASHTBLSIZE; i++) {    for(i= 0; i<HASHTBLSIZE; i++) {
951      temp= env->symbols[i];      temp= env->symbols[i];
952      while(temp!=NULL) {      while(temp!=NULL) {
953    #ifdef DEBUG
954          if (temp->val != NULL && temp->val->gc.flag.protect)
955            printf("(protected) ");
956    #endif /* DEBUG */
957        printf("%s\n", temp->id);        printf("%s\n", temp->id);
958        temp= temp->next;        temp= temp->next;
959      }      }
# Line 931  void forget_sym(symbol **hash_entry) Line 976  void forget_sym(symbol **hash_entry)
976  extern void forget(environment *env)  extern void forget(environment *env)
977  {  {
978    char* sym_id;    char* sym_id;
   stackitem *stack_head= env->head;  
979    
980    if(stack_head==NULL) {    if(env->head->type==empty) {
981      printerr("Too Few Arguments");      printerr("Too Few Arguments");
982      env->err=1;      env->err= 1;
983      return;      return;
984    }    }
985        
986    if(stack_head->item->type!=symb) {    if(CAR(env->head)->type!=symb) {
987      printerr("Bad Argument Type");      printerr("Bad Argument Type");
988      env->err=2;      env->err= 2;
989      return;      return;
990    }    }
991    
992    sym_id= ((symbol*)(stack_head->item->content.ptr))->id;    sym_id= CAR(env->head)->content.sym->id;
993    toss(env);    toss(env);
994    
995    return forget_sym(hash(env->symbols, sym_id));    return forget_sym(hash(env->symbols, sym_id));
# Line 963  int main(int argc, char **argv) Line 1007  int main(int argc, char **argv)
1007    
1008    int c;                        /* getopt option character */    int c;                        /* getopt option character */
1009    
1010    #ifdef __linux__
1011    mtrace();    mtrace();
1012    #endif
1013    
1014    init_env(&myenv);    init_env(&myenv);
1015    
# Line 977  int main(int argc, char **argv) Line 1023  int main(int argc, char **argv)
1023          break;          break;
1024        case '?':        case '?':
1025          fprintf (stderr,          fprintf (stderr,
1026                   "Unknown option character `\\x%x'.\n",                   "Unknown option character '\\x%x'.\n",
1027                   optopt);                   optopt);
1028          return EX_USAGE;          return EX_USAGE;
1029        default:        default:
# Line 996  int main(int argc, char **argv) Line 1042  int main(int argc, char **argv)
1042    if(myenv.interactive) {    if(myenv.interactive) {
1043      printf("Stack version $Revision$\n\      printf("Stack version $Revision$\n\
1044  Copyright (C) 2002  Mats Alritzson and Teddy Hogeborn\n\  Copyright (C) 2002  Mats Alritzson and Teddy Hogeborn\n\
1045  Stack comes with ABSOLUTELY NO WARRANTY; for details type `warranty;'.\n\  Stack comes with ABSOLUTELY NO WARRANTY; for details type 'warranty;'.\n\
1046  This is free software, and you are welcome to redistribute it\n\  This is free software, and you are welcome to redistribute it\n\
1047  under certain conditions; type `copying;' for details.\n");  under certain conditions; type 'copying;' for details.\n");
1048    }    }
1049    
1050    while(1) {    while(1) {
# Line 1013  under certain conditions; type `copying; Line 1059  under certain conditions; type `copying;
1059        }        }
1060        myenv.err=0;        myenv.err=0;
1061      }      }
1062      sx_72656164(&myenv);      sx_72656164(&myenv);        /* "read" */
1063      if (myenv.err==4) {      if (myenv.err==4) {         /* EOF */
1064        return EXIT_SUCCESS;      /* EOF */        myenv.err=0;
1065      } else if(myenv.head!=NULL        quit(&myenv);
1066                && myenv.head->item->type==symb      } else if(myenv.head->type!=empty
1067                && ((symbol*)(myenv.head->item->content.ptr))->id[0]==';') {                && CAR(myenv.head)->type==symb
1068                  && CAR(myenv.head)->content.sym->id[0]
1069                  ==';') {
1070        toss(&myenv);             /* No error check in main */        toss(&myenv);             /* No error check in main */
1071        eval(&myenv);        eval(&myenv);
1072      }      }
# Line 1037  extern void sx_2b(environment *env) Line 1085  extern void sx_2b(environment *env)
1085    char* new_string;    char* new_string;
1086    value *a_val, *b_val;    value *a_val, *b_val;
1087    
1088    if((env->head)==NULL || env->head->next==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
1089      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1090      env->err= 1;      env->err= 1;
1091      return;      return;
1092    }    }
1093    
1094    if(env->head->item->type==string    if(CAR(env->head)->type==string
1095       && env->head->next->item->type==string) {       && CAR(CDR(env->head))->type==string) {
1096      a_val= env->head->item;      a_val= CAR(env->head);
1097      b_val= env->head->next->item;      b_val= CAR(CDR(env->head));
1098      protect(a_val); protect(b_val);      protect(a_val); protect(b_val);
1099      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1100      toss(env); if(env->err) return;      toss(env); if(env->err) return;
# Line 1061  extern void sx_2b(environment *env) Line 1109  extern void sx_2b(environment *env)
1109      return;      return;
1110    }    }
1111        
1112    if(env->head->item->type==integer    if(CAR(env->head)->type==integer
1113       && env->head->next->item->type==integer) {       && CAR(CDR(env->head))->type==integer) {
1114      a=env->head->item->content.i;      a= CAR(env->head)->content.i;
1115      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1116      b=env->head->item->content.i;      b= CAR(env->head)->content.i;
1117      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1118      push_int(env, b+a);      push_int(env, b+a);
1119    
1120      return;      return;
1121    }    }
1122    
1123    if(env->head->item->type==tfloat    if(CAR(env->head)->type==tfloat
1124       && env->head->next->item->type==tfloat) {       && CAR(CDR(env->head))->type==tfloat) {
1125      fa= env->head->item->content.f;      fa= CAR(env->head)->content.f;
1126      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1127      fb= env->head->item->content.f;      fb= CAR(env->head)->content.f;
1128      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1129      push_float(env, fb+fa);      push_float(env, fb+fa);
1130            
1131      return;      return;
1132    }    }
1133    
1134    if(env->head->item->type==tfloat    if(CAR(env->head)->type==tfloat
1135       && env->head->next->item->type==integer) {       && CAR(CDR(env->head))->type==integer) {
1136      fa= env->head->item->content.f;      fa= CAR(env->head)->content.f;
1137      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1138      b= env->head->item->content.i;      b= CAR(env->head)->content.i;
1139      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1140      push_float(env, b+fa);      push_float(env, b+fa);
1141            
1142      return;      return;
1143    }    }
1144    
1145    if(env->head->item->type==integer    if(CAR(env->head)->type==integer
1146       && env->head->next->item->type==tfloat) {       && CAR(CDR(env->head))->type==tfloat) {
1147      a= env->head->item->content.i;      a= CAR(env->head)->content.i;
1148      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1149      fb= env->head->item->content.f;      fb= CAR(env->head)->content.f;
1150      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1151      push_float(env, fb+a);      push_float(env, fb+a);
1152    
# Line 1115  extern void sx_2d(environment *env) Line 1163  extern void sx_2d(environment *env)
1163    int a, b;    int a, b;
1164    float fa, fb;    float fa, fb;
1165    
1166    if((env->head)==NULL || env->head->next==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
1167      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1168      env->err=1;      env->err=1;
1169      return;      return;
1170    }    }
1171        
1172    if(env->head->item->type==integer    if(CAR(env->head)->type==integer
1173       && env->head->next->item->type==integer) {       && CAR(CDR(env->head))->type==integer) {
1174      a=env->head->item->content.i;      a= CAR(env->head)->content.i;
1175      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1176      b=env->head->item->content.i;      b= CAR(env->head)->content.i;
1177      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1178      push_int(env, b-a);      push_int(env, b-a);
1179    
1180      return;      return;
1181    }    }
1182    
1183    if(env->head->item->type==tfloat    if(CAR(env->head)->type==tfloat
1184       && env->head->next->item->type==tfloat) {       && CAR(CDR(env->head))->type==tfloat) {
1185      fa= env->head->item->content.f;      fa= CAR(env->head)->content.f;
1186      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1187      fb= env->head->item->content.f;      fb= CAR(env->head)->content.f;
1188      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1189      push_float(env, fb-fa);      push_float(env, fb-fa);
1190            
1191      return;      return;
1192    }    }
1193    
1194    if(env->head->item->type==tfloat    if(CAR(env->head)->type==tfloat
1195       && env->head->next->item->type==integer) {       && CAR(CDR(env->head))->type==integer) {
1196      fa= env->head->item->content.f;      fa= CAR(env->head)->content.f;
1197      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1198      b= env->head->item->content.i;      b= CAR(env->head)->content.i;
1199      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1200      push_float(env, b-fa);      push_float(env, b-fa);
1201            
1202      return;      return;
1203    }    }
1204    
1205    if(env->head->item->type==integer    if(CAR(env->head)->type==integer
1206       && env->head->next->item->type==tfloat) {       && CAR(CDR(env->head))->type==tfloat) {
1207      a= env->head->item->content.i;      a= CAR(env->head)->content.i;
1208      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1209      fb= env->head->item->content.f;      fb= CAR(env->head)->content.f;
1210      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1211      push_float(env, fb-a);      push_float(env, fb-a);
1212    
# Line 1175  extern void sx_3e(environment *env) Line 1223  extern void sx_3e(environment *env)
1223    int a, b;    int a, b;
1224    float fa, fb;    float fa, fb;
1225    
1226    if((env->head)==NULL || env->head->next==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
1227      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1228      env->err=1;      env->err= 1;
1229      return;      return;
1230    }    }
1231        
1232    if(env->head->item->type==integer    if(CAR(env->head)->type==integer
1233       && env->head->next->item->type==integer) {       && CAR(CDR(env->head))->type==integer) {
1234      a=env->head->item->content.i;      a= CAR(env->head)->content.i;
1235      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1236      b=env->head->item->content.i;      b= CAR(env->head)->content.i;
1237      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1238      push_int(env, b>a);      push_int(env, b>a);
1239    
1240      return;      return;
1241    }    }
1242    
1243    if(env->head->item->type==tfloat    if(CAR(env->head)->type==tfloat
1244       && env->head->next->item->type==tfloat) {       && CAR(CDR(env->head))->type==tfloat) {
1245      fa= env->head->item->content.f;      fa= CAR(env->head)->content.f;
1246      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1247      fb= env->head->item->content.f;      fb= CAR(env->head)->content.f;
1248      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1249      push_int(env, fb>fa);      push_int(env, fb>fa);
1250            
1251      return;      return;
1252    }    }
1253    
1254    if(env->head->item->type==tfloat    if(CAR(env->head)->type==tfloat
1255       && env->head->next->item->type==integer) {       && CAR(CDR(env->head))->type==integer) {
1256      fa= env->head->item->content.f;      fa= CAR(env->head)->content.f;
1257      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1258      b= env->head->item->content.i;      b= CAR(env->head)->content.i;
1259      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1260      push_int(env, b>fa);      push_int(env, b>fa);
1261            
1262      return;      return;
1263    }    }
1264    
1265    if(env->head->item->type==integer    if(CAR(env->head)->type==integer
1266       && env->head->next->item->type==tfloat) {       && CAR(CDR(env->head))->type==tfloat) {
1267      a= env->head->item->content.i;      a= CAR(env->head)->content.i;
1268      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1269      fb= env->head->item->content.f;      fb= CAR(env->head)->content.f;
1270      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1271      push_int(env, fb>a);      push_int(env, fb>a);
1272    
# Line 1226  extern void sx_3e(environment *env) Line 1274  extern void sx_3e(environment *env)
1274    }    }
1275    
1276    printerr("Bad Argument Type");    printerr("Bad Argument Type");
1277    env->err=2;    env->err= 2;
1278  }  }
1279    
1280  /* "<" */  /* "<" */
# Line 1253  extern void sx_3e3d(environment *env) Line 1301  extern void sx_3e3d(environment *env)
1301  /* Return copy of a value */  /* Return copy of a value */
1302  value *copy_val(environment *env, value *old_value)  value *copy_val(environment *env, value *old_value)
1303  {  {
   stackitem *old_item, *new_item, *prev_item;  
1304    value *new_value;    value *new_value;
1305    
1306      if(old_value==NULL)
1307        return NULL;
1308    
1309    protect(old_value);    protect(old_value);
1310    new_value= new_val(env);    new_value= new_val(env);
   protect(new_value);  
1311    new_value->type= old_value->type;    new_value->type= old_value->type;
1312    
1313    switch(old_value->type){    switch(old_value->type){
# Line 1272  value *copy_val(environment *env, value Line 1321  value *copy_val(environment *env, value
1321      (char *)(new_value->content.ptr)=      (char *)(new_value->content.ptr)=
1322        strdup((char *)(old_value->content.ptr));        strdup((char *)(old_value->content.ptr));
1323      break;      break;
1324    case list:    case tcons:
     new_value->content.ptr= NULL;  
1325    
1326      prev_item= NULL;      new_value->content.c= malloc(sizeof(cons));
1327      old_item= (stackitem*)(old_value->content.ptr);      assert(new_value->content.c!=NULL);
1328    
1329      while(old_item != NULL) {   /* While list is not empty */      CAR(new_value)= copy_val(env, CAR(old_value)); /* recurse */
1330        new_item= malloc(sizeof(stackitem));      CDR(new_value)= copy_val(env, CDR(old_value)); /* recurse */
       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;  
     }      
1331      break;      break;
1332    }    }
1333    
1334    unprotect(old_value); unprotect(new_value);    unprotect(old_value);
1335    
1336    return new_value;    return new_value;
1337  }  }
# Line 1301  value *copy_val(environment *env, value Line 1339  value *copy_val(environment *env, value
1339  /* "dup"; duplicates an item on the stack */  /* "dup"; duplicates an item on the stack */
1340  extern void sx_647570(environment *env)  extern void sx_647570(environment *env)
1341  {  {
1342    if((env->head)==NULL) {    if(env->head->type==empty) {
1343      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1344      env->err= 1;      env->err= 1;
1345      return;      return;
1346    }    }
1347    push_val(env, copy_val(env, env->head->item));    push_val(env, copy_val(env, CAR(env->head)));
1348  }  }
1349    
1350  /* "if", If-Then */  /* "if", If-Then */
# Line 1314  extern void sx_6966(environment *env) Line 1352  extern void sx_6966(environment *env)
1352  {  {
1353    int truth;    int truth;
1354    
1355    if((env->head)==NULL || env->head->next==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
1356      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1357      env->err= 1;      env->err= 1;
1358      return;      return;
1359    }    }
1360    
1361    if(env->head->next->item->type != integer) {    if(CAR(CDR(env->head))->type != integer) {
1362      printerr("Bad Argument Type");      printerr("Bad Argument Type");
1363      env->err=2;      env->err= 2;
1364      return;      return;
1365    }    }
1366        
1367    swap(env);    swap(env);
1368    if(env->err) return;    if(env->err) return;
1369        
1370    truth=env->head->item->content.i;    truth= CAR(env->head)->content.i;
1371    
1372    toss(env);    toss(env);
1373    if(env->err) return;    if(env->err) return;
# Line 1345  extern void ifelse(environment *env) Line 1383  extern void ifelse(environment *env)
1383  {  {
1384    int truth;    int truth;
1385    
1386    if((env->head)==NULL || env->head->next==NULL    if(env->head->type==empty || CDR(env->head)->type==empty
1387       || env->head->next->next==NULL) {       || CDR(CDR(env->head))->type==empty) {
1388      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1389      env->err=1;      env->err= 1;
1390      return;      return;
1391    }    }
1392    
1393    if(env->head->next->next->item->type != integer) {    if(CAR(CDR(CDR(env->head)))->type!=integer) {
1394      printerr("Bad Argument Type");      printerr("Bad Argument Type");
1395      env->err=2;      env->err= 2;
1396      return;      return;
1397    }    }
1398        
1399    rot(env);    rot(env);
1400    if(env->err) return;    if(env->err) return;
1401        
1402    truth=env->head->item->content.i;    truth= CAR(env->head)->content.i;
1403    
1404    toss(env);    toss(env);
1405    if(env->err) return;    if(env->err) return;
# Line 1376  extern void ifelse(environment *env) Line 1414  extern void ifelse(environment *env)
1414    eval(env);    eval(env);
1415  }  }
1416    
1417    extern void sx_656c7365(environment *env)
1418    {
1419      if(env->head->type==empty || CDR(env->head)->type==empty
1420         || CDR(CDR(env->head))->type==empty || CDR(CDR(CDR(env->head)))->type==empty
1421         || CDR(CDR(CDR(CDR(env->head))))->type==empty) {
1422        printerr("Too Few Arguments");
1423        env->err= 1;
1424        return;
1425      }
1426    
1427      if(CAR(CDR(env->head))->type!=symb
1428         || strcmp(CAR(CDR(env->head))->content.sym->id, "then")!=0
1429         || CAR(CDR(CDR(CDR(env->head))))->type!=symb
1430         || strcmp(CAR(CDR(CDR(CDR(env->head))))->content.sym->id, "if")!=0) {
1431        printerr("Bad Argument Type");
1432        env->err= 2;
1433        return;
1434      }
1435    
1436      swap(env); toss(env); rot(env); toss(env);
1437      ifelse(env);
1438    }
1439    
1440    extern void then(environment *env)
1441    {
1442      if(env->head->type==empty || CDR(env->head)->type==empty
1443         || CDR(CDR(env->head))->type==empty) {
1444        printerr("Too Few Arguments");
1445        env->err= 1;
1446        return;
1447      }
1448    
1449      if(CAR(CDR(env->head))->type!=symb
1450         || strcmp(CAR(CDR(env->head))->content.sym->id, "if")!=0) {
1451        printerr("Bad Argument Type");
1452        env->err= 2;
1453        return;
1454      }
1455    
1456      swap(env); toss(env);
1457      sx_6966(env);
1458    }
1459    
1460  /* "while" */  /* "while" */
1461  extern void sx_7768696c65(environment *env)  extern void sx_7768696c65(environment *env)
1462  {  {
1463    int truth;    int truth;
1464    value *loop, *test;    value *loop, *test;
1465    
1466    if((env->head)==NULL || env->head->next==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
1467      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1468      env->err=1;      env->err= 1;
1469      return;      return;
1470    }    }
1471    
1472    loop= env->head->item;    loop= CAR(env->head);
1473    protect(loop);    protect(loop);
1474    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1475    
1476    test= env->head->item;    test= CAR(env->head);
1477    protect(test);    protect(test);
1478    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1479    
# Line 1400  extern void sx_7768696c65(environment *e Line 1481  extern void sx_7768696c65(environment *e
1481      push_val(env, test);      push_val(env, test);
1482      eval(env);      eval(env);
1483            
1484      if(env->head->item->type != integer) {      if(CAR(env->head)->type != integer) {
1485        printerr("Bad Argument Type");        printerr("Bad Argument Type");
1486        env->err= 2;        env->err= 2;
1487        return;        return;
1488      }      }
1489            
1490      truth= env->head->item->content.i;      truth= CAR(env->head)->content.i;
1491      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1492            
1493      if(truth) {      if(truth) {
# Line 1428  extern void sx_666f72(environment *env) Line 1509  extern void sx_666f72(environment *env)
1509    value *loop;    value *loop;
1510    int foo1, foo2;    int foo1, foo2;
1511    
1512    if(env->head==NULL || env->head->next==NULL    if(env->head->type==empty || CDR(env->head)->type==empty
1513       || env->head->next->next==NULL) {       || CDR(CDR(env->head))->type==empty) {
1514      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1515      env->err= 1;      env->err= 1;
1516      return;      return;
1517    }    }
1518    
1519    if(env->head->next->item->type!=integer    if(CAR(CDR(env->head))->type!=integer
1520       || env->head->next->next->item->type!=integer) {       || CAR(CDR(CDR(env->head)))->type!=integer) {
1521      printerr("Bad Argument Type");      printerr("Bad Argument Type");
1522      env->err= 2;      env->err= 2;
1523      return;      return;
1524    }    }
1525    
1526    loop= env->head->item;    loop= CAR(env->head);
1527    protect(loop);    protect(loop);
1528    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1529    
1530    foo2= env->head->item->content.i;    foo2= CAR(env->head)->content.i;
1531    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1532    
1533    foo1= env->head->item->content.i;    foo1= CAR(env->head)->content.i;
1534    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1535    
1536    if(foo1<=foo2) {    if(foo1<=foo2) {
# Line 1474  extern void sx_666f72(environment *env) Line 1555  extern void sx_666f72(environment *env)
1555  extern void foreach(environment *env)  extern void foreach(environment *env)
1556  {    {  
1557    value *loop, *foo;    value *loop, *foo;
1558    stackitem *iterator;    value *iterator;
1559        
1560    if((env->head)==NULL || env->head->next==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
1561      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1562      env->err= 1;      env->err= 1;
1563      return;      return;
1564    }    }
1565    
1566    if(env->head->next->item->type != list) {    if(CAR(CDR(env->head))->type!=tcons) {
1567      printerr("Bad Argument Type");      printerr("Bad Argument Type");
1568      env->err= 2;      env->err= 2;
1569      return;      return;
1570    }    }
1571    
1572    loop= env->head->item;    loop= CAR(env->head);
1573    protect(loop);    protect(loop);
1574    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1575    
1576    foo= env->head->item;    foo= CAR(env->head);
1577    protect(foo);    protect(foo);
1578    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1579    
1580    iterator= foo->content.ptr;    iterator= foo;
1581    
1582    while(iterator!=NULL) {    while(iterator!=NULL) {
1583      push_val(env, iterator->item);      push_val(env, CAR(iterator));
1584      push_val(env, loop);      push_val(env, loop);
1585      eval(env); if(env->err) return;      eval(env); if(env->err) return;
1586      iterator= iterator->next;      if (iterator->type == tcons){
1587          iterator= CDR(iterator);
1588        } else {
1589          printerr("Bad Argument Type"); /* Improper list */
1590          env->err= 2;
1591          break;
1592        }
1593    }    }
1594    unprotect(loop); unprotect(foo);    unprotect(loop); unprotect(foo);
1595  }  }
# Line 1511  extern void foreach(environment *env) Line 1598  extern void foreach(environment *env)
1598  extern void to(environment *env)  extern void to(environment *env)
1599  {  {
1600    int ending, start, i;    int ending, start, i;
1601    stackitem *iterator, *temp;    value *iterator, *temp;
   value *pack;  
1602    
1603    if((env->head)==NULL || env->head->next==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
1604      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1605      env->err=1;      env->err= 1;
1606      return;      return;
1607    }    }
1608    
1609    if(env->head->item->type!=integer    if(CAR(env->head)->type!=integer
1610       || env->head->next->item->type!=integer) {       || CAR(CDR(env->head))->type!=integer) {
1611      printerr("Bad Argument Type");      printerr("Bad Argument Type");
1612      env->err=2;      env->err= 2;
1613      return;      return;
1614    }    }
1615    
1616    ending= env->head->item->content.i;    ending= CAR(env->head)->content.i;
1617    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1618    start= env->head->item->content.i;    start= CAR(env->head)->content.i;
1619    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1620    
1621    push_sym(env, "[");    push_sym(env, "[");
# Line 1543  extern void to(environment *env) Line 1629  extern void to(environment *env)
1629    }    }
1630    
1631    iterator= env->head;    iterator= env->head;
   pack= new_val(env);  
   protect(pack);  
1632    
1633    if(iterator==NULL    if(iterator->type==empty
1634       || (iterator->item->type==symb       || (CAR(iterator)->type==symb
1635       && ((symbol*)(iterator->item->content.ptr))->id[0]=='[')) {           && CAR(iterator)->content.sym->id[0]=='[')) {
1636      temp= NULL;      temp= NULL;
1637      toss(env);      toss(env);
1638    } else {    } else {
1639      /* Search for first delimiter */      /* Search for first delimiter */
1640      while(iterator->next!=NULL      while(CDR(iterator)!=NULL
1641            && (iterator->next->item->type!=symb            && (CAR(CDR(iterator))->type!=symb
1642            || ((symbol*)(iterator->next->item->content.ptr))->id[0]!='['))                || CAR(CDR(iterator))->content.sym->id[0]!='['))
1643        iterator= iterator->next;        iterator= CDR(iterator);
1644            
1645      /* Extract list */      /* Extract list */
1646      temp= env->head;      temp= env->head;
1647      env->head= iterator->next;      env->head= CDR(iterator);
1648      iterator->next= NULL;      CDR(iterator)= NULL;
1649    
     pack->type= list;  
     pack->content.ptr= temp;  
       
1650      if(env->head!=NULL)      if(env->head!=NULL)
1651        toss(env);        toss(env);
1652    }    }
1653    
1654    /* Push list */    /* Push list */
1655      push_val(env, temp);
   push_val(env, pack);  
   
   unprotect(pack);  
1656  }  }
1657    
1658  /* Read a string */  /* Read a string */
# Line 1613  extern void sx_72656164(environment *env Line 1691  extern void sx_72656164(environment *env
1691      }      }
1692      readline(env); if(env->err) return;      readline(env); if(env->err) return;
1693    
1694      if(((char *)(env->head->item->content.ptr))[0]=='\0'){      if(((char *)(CAR(env->head)->content.ptr))[0]=='\0'){
1695        env->err= 4;              /* "" means EOF */        env->err= 4;              /* "" means EOF */
1696        return;        return;
1697      }      }
1698            
1699      env->in_string= malloc(strlen(env->head->item->content.ptr)+1);      env->in_string= malloc(strlen(CAR(env->head)->content.ptr)+1);
1700      env->free_string= env->in_string; /* Save the original pointer */      env->free_string= env->in_string; /* Save the original pointer */
1701      strcpy(env->in_string, env->head->item->content.ptr);      strcpy(env->in_string, CAR(env->head)->content.ptr);
1702      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1703    }    }
1704        
# Line 1669  extern void sx_72656164(environment *env Line 1747  extern void sx_72656164(environment *env
1747      return sx_72656164(env);      return sx_72656164(env);
1748  }  }
1749    
1750    #ifdef __linux__
1751  extern void beep(environment *env)  extern void beep(environment *env)
1752  {  {
1753    int freq, dur, period, ticks;    int freq, dur, period, ticks;
1754    
1755    if((env->head)==NULL || env->head->next==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
1756      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1757      env->err=1;      env->err= 1;
1758      return;      return;
1759    }    }
1760    
1761    if(env->head->item->type!=integer    if(CAR(env->head)->type!=integer
1762       || env->head->next->item->type!=integer) {       || CAR(CDR(env->head))->type!=integer) {
1763      printerr("Bad Argument Type");      printerr("Bad Argument Type");
1764      env->err=2;      env->err= 2;
1765      return;      return;
1766    }    }
1767    
1768    dur=env->head->item->content.i;    dur= CAR(env->head)->content.i;
1769    toss(env);    toss(env);
1770    freq=env->head->item->content.i;    freq= CAR(env->head)->content.i;
1771    toss(env);    toss(env);
1772    
1773    period=1193180/freq;          /* convert freq from Hz to period    period= 1193180/freq;         /* convert freq from Hz to period
1774                                     length */                                     length */
1775    ticks=dur*.001193180;         /* convert duration from µseconds to    ticks= dur*.001193180;        /* convert duration from µseconds to
1776                                     timer ticks */                                     timer ticks */
1777    
1778  /*    ticks=dur/1000; */  /*    ticks=dur/1000; */
1779    
1780    /*  if (ioctl(STDOUT_FILENO, KDMKTONE, (125<<16) + 0x637)==0) */        /*  if (ioctl(STDOUT_FILENO, KDMKTONE, (125<<16) + 0x637)==0) */
1781    switch (ioctl(STDOUT_FILENO, KDMKTONE, (ticks<<16) | period)){    switch (ioctl(STDOUT_FILENO, KDMKTONE, (ticks<<16) | period)){
1782    case 0:    case 0:
1783      usleep(dur);      usleep(dur);
1784      return;      return;
1785    case -1:    case -1:
1786      perror("beep");      perror("beep");
1787      env->err=5;      env->err= 5;
1788      return;      return;
1789    default:    default:
1790      abort();      abort();
1791    }    }
1792  }  }
1793    #endif /* __linux__ */
1794    
1795  /* "wait" */  /* "wait" */
1796  extern void sx_77616974(environment *env)  extern void sx_77616974(environment *env)
1797  {  {
1798    int dur;    int dur;
1799    
1800    if((env->head)==NULL) {    if(env->head->type==empty) {
1801      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1802      env->err=1;      env->err= 1;
1803      return;      return;
1804    }    }
1805    
1806    if(env->head->item->type!=integer) {    if(CAR(env->head)->type!=integer) {
1807      printerr("Bad Argument Type");      printerr("Bad Argument Type");
1808      env->err=2;      env->err= 2;
1809      return;      return;
1810    }    }
1811    
1812    dur=env->head->item->content.i;    dur= CAR(env->head)->content.i;
1813    toss(env);    toss(env);
1814    
1815    usleep(dur);    usleep(dur);
# Line 1737  extern void sx_77616974(environment *env Line 1817  extern void sx_77616974(environment *env
1817    
1818  extern void copying(environment *env)  extern void copying(environment *env)
1819  {  {
1820    printf("GNU GENERAL PUBLIC LICENSE\n\    printf("                  GNU GENERAL PUBLIC LICENSE\n\
1821                         Version 2, June 1991\n\                         Version 2, June 1991\n\
1822  \n\  \n\
1823   Copyright (C) 1989, 1991 Free Software Foundation, Inc.\n\   Copyright (C) 1989, 1991 Free Software Foundation, Inc.\n\
# Line 2026  extern void sx_2a(environment *env) Line 2106  extern void sx_2a(environment *env)
2106    int a, b;    int a, b;
2107    float fa, fb;    float fa, fb;
2108    
2109    if((env->head)==NULL || env->head->next==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
2110      printerr("Too Few Arguments");      printerr("Too Few Arguments");
2111      env->err=1;      env->err= 1;
2112      return;      return;
2113    }    }
2114        
2115    if(env->head->item->type==integer    if(CAR(env->head)->type==integer
2116       && env->head->next->item->type==integer) {       && CAR(CDR(env->head))->type==integer) {
2117      a=env->head->item->content.i;      a= CAR(env->head)->content.i;
2118      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2119      b=env->head->item->content.i;      b= CAR(env->head)->content.i;
2120      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2121      push_int(env, b*a);      push_int(env, b*a);
2122    
2123      return;      return;
2124    }    }
2125    
2126    if(env->head->item->type==tfloat    if(CAR(env->head)->type==tfloat
2127       && env->head->next->item->type==tfloat) {       && CAR(CDR(env->head))->type==tfloat) {
2128      fa= env->head->item->content.f;      fa= CAR(env->head)->content.f;
2129      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2130      fb= env->head->item->content.f;      fb= CAR(env->head)->content.f;
2131      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2132      push_float(env, fb*fa);      push_float(env, fb*fa);
2133            
2134      return;      return;
2135    }    }
2136    
2137    if(env->head->item->type==tfloat    if(CAR(env->head)->type==tfloat
2138       && env->head->next->item->type==integer) {       && CAR(CDR(env->head))->type==integer) {
2139      fa= env->head->item->content.f;      fa= CAR(env->head)->content.f;
2140      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2141      b= env->head->item->content.i;      b= CAR(env->head)->content.i;
2142      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2143      push_float(env, b*fa);      push_float(env, b*fa);
2144            
2145      return;      return;
2146    }    }
2147    
2148    if(env->head->item->type==integer    if(CAR(env->head)->type==integer
2149       && env->head->next->item->type==tfloat) {       && CAR(CDR(env->head))->type==tfloat) {
2150      a= env->head->item->content.i;      a= CAR(env->head)->content.i;
2151      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2152      fb= env->head->item->content.f;      fb= CAR(env->head)->content.f;
2153      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2154      push_float(env, fb*a);      push_float(env, fb*a);
2155    
# Line 2077  extern void sx_2a(environment *env) Line 2157  extern void sx_2a(environment *env)
2157    }    }
2158    
2159    printerr("Bad Argument Type");    printerr("Bad Argument Type");
2160    env->err=2;    env->err= 2;
2161  }  }
2162    
2163  /* "/" */  /* "/" */
# Line 2086  extern void sx_2f(environment *env) Line 2166  extern void sx_2f(environment *env)
2166    int a, b;    int a, b;
2167    float fa, fb;    float fa, fb;
2168    
2169    if((env->head)==NULL || env->head->next==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
2170      printerr("Too Few Arguments");      printerr("Too Few Arguments");
2171      env->err=1;      env->err= 1;
2172      return;      return;
2173    }    }
2174        
2175    if(env->head->item->type==integer    if(CAR(env->head)->type==integer
2176       && env->head->next->item->type==integer) {       && CAR(CDR(env->head))->type==integer) {
2177      a=env->head->item->content.i;      a= CAR(env->head)->content.i;
2178      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2179      b=env->head->item->content.i;      b= CAR(env->head)->content.i;
2180      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2181      push_float(env, b/a);      push_float(env, b/a);
2182    
2183      return;      return;
2184    }    }
2185    
2186    if(env->head->item->type==tfloat    if(CAR(env->head)->type==tfloat
2187       && env->head->next->item->type==tfloat) {       && CAR(CDR(env->head))->type==tfloat) {
2188      fa= env->head->item->content.f;      fa= CAR(env->head)->content.f;
2189      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2190      fb= env->head->item->content.f;      fb= CAR(env->head)->content.f;
2191      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2192      push_float(env, fb/fa);      push_float(env, fb/fa);
2193            
2194      return;      return;
2195    }    }
2196    
2197    if(env->head->item->type==tfloat    if(CAR(env->head)->type==tfloat
2198       && env->head->next->item->type==integer) {       && CAR(CDR(env->head))->type==integer) {
2199      fa= env->head->item->content.f;      fa= CAR(env->head)->content.f;
2200      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2201      b= env->head->item->content.i;      b= CAR(env->head)->content.i;
2202      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2203      push_float(env, b/fa);      push_float(env, b/fa);
2204            
2205      return;      return;
2206    }    }
2207    
2208    if(env->head->item->type==integer    if(CAR(env->head)->type==integer
2209       && env->head->next->item->type==tfloat) {       && CAR(CDR(env->head))->type==tfloat) {
2210      a= env->head->item->content.i;      a= CAR(env->head)->content.i;
2211      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2212      fb= env->head->item->content.f;      fb= CAR(env->head)->content.f;
2213      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2214      push_float(env, fb/a);      push_float(env, fb/a);
2215    
# Line 2137  extern void sx_2f(environment *env) Line 2217  extern void sx_2f(environment *env)
2217    }    }
2218    
2219    printerr("Bad Argument Type");    printerr("Bad Argument Type");
2220    env->err=2;    env->err= 2;
2221  }  }
2222    
2223  /* "mod" */  /* "mod" */
# Line 2145  extern void mod(environment *env) Line 2225  extern void mod(environment *env)
2225  {  {
2226    int a, b;    int a, b;
2227    
2228    if((env->head)==NULL || env->head->next==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
2229      printerr("Too Few Arguments");      printerr("Too Few Arguments");
2230      env->err= 1;      env->err= 1;
2231      return;      return;
2232    }    }
2233        
2234    if(env->head->item->type==integer    if(CAR(env->head)->type==integer
2235       && env->head->next->item->type==integer) {       && CAR(CDR(env->head))->type==integer) {
2236      a= env->head->item->content.i;      a= CAR(env->head)->content.i;
2237      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2238      b= env->head->item->content.i;      b= CAR(env->head)->content.i;
2239      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2240      push_int(env, b%a);      push_int(env, b%a);
2241    
# Line 2163  extern void mod(environment *env) Line 2243  extern void mod(environment *env)
2243    }    }
2244    
2245    printerr("Bad Argument Type");    printerr("Bad Argument Type");
2246    env->err=2;    env->err= 2;
2247  }  }
2248    
2249  /* "div" */  /* "div" */
# Line 2171  extern void sx_646976(environment *env) Line 2251  extern void sx_646976(environment *env)
2251  {  {
2252    int a, b;    int a, b;
2253        
2254    if((env->head)==NULL || env->head->next==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
2255      printerr("Too Few Arguments");      printerr("Too Few Arguments");
2256      env->err= 1;      env->err= 1;
2257      return;      return;
2258    }    }
2259    
2260    if(env->head->item->type==integer    if(CAR(env->head)->type==integer
2261       && env->head->next->item->type==integer) {       && CAR(CDR(env->head))->type==integer) {
2262      a= env->head->item->content.i;      a= CAR(env->head)->content.i;
2263      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2264      b= env->head->item->content.i;      b= CAR(env->head)->content.i;
2265      toss(env); if(env->err) return;      toss(env); if(env->err) return;
2266      push_int(env, (int)b/a);      push_int(env, (int)b/a);
2267    
Legend:
Removed from v.1.99  
changed lines
  Added in v.1.111
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26