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

Diff of /stack/stack.c

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

revision 1.92 by masse, Fri Mar 8 06:44:15 2002 UTC revision 1.106 by masse, Tue Mar 12 15:13:48 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 48  void init_env(environment *env) Line 51  void init_env(environment *env)
51  {  {
52    int i;    int i;
53    
54    env->gc_limit= 20;    env->gc_limit= 400000;
55    env->gc_count= 0;    env->gc_count= 0;
56    env->gc_ref= NULL;    env->gc_ref= NULL;
   env->gc_protect= NULL;  
57    
58    env->head= NULL;    env->head= NULL;
59    for(i= 0; i<HASHTBLSIZE; i++)    for(i= 0; i<HASHTBLSIZE; i++)
# Line 63  void init_env(environment *env) Line 65  void init_env(environment *env)
65    env->interactive= 1;    env->interactive= 1;
66  }  }
67    
68  void printerr(const char* in_string) {  void printerr(const char* in_string)
69    {
70    fprintf(stderr, "Err: %s\n", in_string);    fprintf(stderr, "Err: %s\n", in_string);
71  }  }
72    
73  /* Discard the top element of the stack. */  /* Discard the top element of the stack. */
74  extern void toss(environment *env)  extern void toss(environment *env)
75  {  {
76    stackitem *temp= env->head;    if(env->head==NULL) {
   
   if((env->head)==NULL) {  
77      printerr("Too Few Arguments");      printerr("Too Few Arguments");
78      env->err= 1;      env->err= 1;
79      return;      return;
80    }    }
81        
82    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 */  
   
   gc_init(env);  
83  }  }
84    
85  /* 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 113  symbol **hash(hashtbl in_hashtbl, const Line 111  symbol **hash(hashtbl in_hashtbl, const
111    }    }
112  }  }
113    
114  value* new_val(environment *env) {  /* Create new value */
115    value* new_val(environment *env)
116    {
117    value *nval= malloc(sizeof(value));    value *nval= malloc(sizeof(value));
118    stackitem *nitem= malloc(sizeof(stackitem));    stackitem *nitem= malloc(sizeof(stackitem));
119    
120    nval->content.ptr= NULL;    nval->content.ptr= NULL;
   protect(env, nval);  
   
   gc_init(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++;    env->gc_count += sizeof(value);
128    unprotect(env);    nval->gc.flag.mark= 0;
129      nval->gc.flag.protect= 0;
130    
131    return nval;    return nval;
132  }  }
133    
134  void gc_mark(value *val) {  /* Mark values recursively.
135    stackitem *iterator;     Marked values are not collected by the GC. */
136    inline void gc_mark(value *val)
137    if(val==NULL || val->gc_garb==0)  {
138      if(val==NULL || val->gc.flag.mark)
139      return;      return;
140    
141    val->gc_garb= 0;    val->gc.flag.mark= 1;
   
   if(val->type==list) {  
     iterator= val->content.ptr;  
142    
143      while(iterator!=NULL) {    if(val->type==tcons) {
144        gc_mark(iterator->item);      gc_mark(CAR(val));
145        iterator= iterator->next;      gc_mark(CDR(val));
     }  
146    }    }
147  }  }
148    
149  extern void gc_init(environment *env) {  inline void gc_maybe(environment *env)
150    stackitem *new_head= NULL, *titem, *iterator= env->gc_ref;  {
151      if(env->gc_count < env->gc_limit)
152        return;
153      else
154        return gc_init(env);
155    }
156    
157    /* Start GC */
158    extern void gc_init(environment *env)
159    {
160      stackitem *new_head= NULL, *titem;
161      cons *iterator;
162    symbol *tsymb;    symbol *tsymb;
163    int i;    int i;
164    
165    if(env->gc_count < env->gc_limit)    if(env->interactive)
166      return;      printf("Garbage collecting.");
167    
168    while(iterator!=NULL) {    /* Mark values on stack */
169      iterator->item->gc_garb= 1;    gc_mark(env->head);
     iterator= iterator->next;  
   }  
170    
171    /* Mark */    if(env->interactive)
172    iterator= env->gc_protect;      printf(".");
   while(iterator!=NULL) {  
     gc_mark(iterator->item);  
     iterator= iterator->next;  
   }  
173    
   iterator= env->head;  
   while(iterator!=NULL) {  
     gc_mark(iterator->item);  
     iterator= iterator->next;  
   }  
174    
175    for(i= 0; i<HASHTBLSIZE; i++) {    /* Mark values in hashtable */
176      tsymb= env->symbols[i];    for(i= 0; i<HASHTBLSIZE; i++)
177      while(tsymb!=NULL) {      for(tsymb= env->symbols[i]; tsymb!=NULL; tsymb= tsymb->next)
178        gc_mark(tsymb->val);        if (tsymb->val != NULL)
179        tsymb= tsymb->next;          gc_mark(tsymb->val);
180      }  
181    }  
182      if(env->interactive)
183        printf(".");
184    
185    
186    env->gc_count= 0;    env->gc_count= 0;
187    
188    /* Sweep */    while(env->gc_ref!=NULL) {    /* Sweep unused values */
   while(env->gc_ref!=NULL) {  
189    
190      if(env->gc_ref->item->gc_garb) {      if(!(env->gc_ref->item->gc.no_gc)){ /* neither mark nor protect */
191        switch(env->gc_ref->item->type) {  
192        case string:        if(env->gc_ref->item->type==string) /* Remove content */
193          free(env->gc_ref->item->content.ptr);          free(env->gc_ref->item->content.ptr);
194          break;  
195        case integer:        free(env->gc_ref->item);  /* Remove from gc_ref */
         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);  
         }  
         break;  
       default:  
         break;  
       }  
       free(env->gc_ref->item);  
       titem= env->gc_ref->next;  
       free(env->gc_ref);  
       env->gc_ref= titem;  
     } else {  
196        titem= env->gc_ref->next;        titem= env->gc_ref->next;
197        env->gc_ref->next= new_head;        free(env->gc_ref);        /* Remove value */
       new_head= env->gc_ref;  
198        env->gc_ref= titem;        env->gc_ref= titem;
199        env->gc_count++;        continue;
200      }      }
201    
202        /* Keep values */    
203        env->gc_count += sizeof(value);
204        if(env->gc_ref->item->type==string)
205          env->gc_count += strlen(env->gc_ref->item->content.ptr);
206        
207        titem= env->gc_ref->next;
208        env->gc_ref->next= new_head;
209        new_head= env->gc_ref;
210        new_head->item->gc.flag.mark= 0;
211        env->gc_ref= titem;
212    }    }
213    
214    env->gc_limit= env->gc_count*2;    if (env->gc_limit < env->gc_count*2)
215        env->gc_limit= env->gc_count*2;
216    
217    env->gc_ref= new_head;    env->gc_ref= new_head;
218    
219      if(env->interactive)
220        printf("done\n");
221    
222  }  }
223    
224  void protect(environment *env, value *val)  /* Protect values from GC */
225    void protect(value *val)
226  {  {
227    stackitem *new_item= malloc(sizeof(stackitem));    if(val==NULL || val->gc.flag.protect)
228    new_item->item= val;      return;
229    new_item->next= env->gc_protect;  
230    env->gc_protect= new_item;    val->gc.flag.protect= 1;
231    
232      if(val->type==tcons) {
233        protect(CAR(val));
234        protect(CDR(val));
235      }
236  }  }
237    
238  void unprotect(environment *env)  /* Unprotect values from GC */
239    void unprotect(value *val)
240  {  {
241    stackitem *temp= env->gc_protect;    if(val==NULL || !(val->gc.flag.protect))
242    env->gc_protect= env->gc_protect->next;      return;
243    free(temp);  
244      val->gc.flag.protect= 0;
245    
246      if(val->type==tcons) {
247        unprotect(CAR(val));
248        unprotect(CDR(val));
249      }
250  }  }
251    
252  /* Push a value onto the stack */  /* Push a value onto the stack */
253  void push_val(environment *env, value *val)  void push_val(environment *env, value *val)
254  {  {
255    stackitem *new_item= malloc(sizeof(stackitem));    value *new_value= new_val(env);
256    new_item->item= val;  
257    new_item->next= env->head;    new_value->content.c= malloc(sizeof(cons));
258    env->head= new_item;    new_value->type= tcons;
259      CAR(new_value)= val;
260      CDR(new_value)= env->head;
261      env->head= new_value;
262  }  }
263    
264  /* Push an integer onto the stack. */  /* Push an integer onto the stack */
265  void push_int(environment *env, int in_val)  void push_int(environment *env, int in_val)
266  {  {
267    value *new_value= new_val(env);    value *new_value= new_val(env);
268        
269    new_value->content.val= in_val;    new_value->content.i= in_val;
270    new_value->type= integer;    new_value->type= integer;
271    
272    push_val(env, new_value);    push_val(env, new_value);
273  }  }
274    
275    /* Push a floating point number onto the stack */
276    void push_float(environment *env, float in_val)
277    {
278      value *new_value= new_val(env);
279    
280      new_value->content.f= in_val;
281      new_value->type= tfloat;
282    
283      push_val(env, new_value);
284    }
285    
286  /* Copy a string onto the stack. */  /* Copy a string onto the stack. */
287  void push_cstring(environment *env, const char *in_string)  void push_cstring(environment *env, const char *in_string)
288  {  {
289    value *new_value= new_val(env);    value *new_value= new_val(env);
290      int length= strlen(in_string)+1;
291    
292    new_value->content.ptr= malloc(strlen(in_string)+1);    new_value->content.ptr= malloc(length);
293      env->gc_count += length;
294    strcpy(new_value->content.ptr, in_string);    strcpy(new_value->content.ptr, in_string);
295    new_value->type= string;    new_value->type= string;
296    
# Line 271  void push_cstring(environment *env, cons Line 298  void push_cstring(environment *env, cons
298  }  }
299    
300  /* Mangle a symbol name to a valid C identifier name */  /* Mangle a symbol name to a valid C identifier name */
301  char *mangle_str(const char *old_string){  char *mangle_str(const char *old_string)
302    {
303    char validchars[]= "0123456789abcdef";    char validchars[]= "0123456789abcdef";
304    char *new_string, *current;    char *new_string, *current;
305    
# Line 289  char *mangle_str(const char *old_string) Line 317  char *mangle_str(const char *old_string)
317    return new_string;            /* The caller must free() it */    return new_string;            /* The caller must free() it */
318  }  }
319    
320  extern void mangle(environment *env){  extern void mangle(environment *env)
321    {
322    char *new_string;    char *new_string;
323    
324    if((env->head)==NULL) {    if(env->head==NULL) {
325      printerr("Too Few Arguments");      printerr("Too Few Arguments");
326      env->err= 1;      env->err= 1;
327      return;      return;
328    }    }
329    
330    if(env->head->item->type!=string) {    if(CAR(env->head)->type!=string) {
331      printerr("Bad Argument Type");      printerr("Bad Argument Type");
332      env->err= 2;      env->err= 2;
333      return;      return;
334    }    }
335    
336    new_string= mangle_str((const char *)(env->head->item->content.ptr));    new_string=
337        mangle_str((const char *)(CAR(env->head)->content.ptr));
338    
339    toss(env);    toss(env);
340    if(env->err) return;    if(env->err) return;
# Line 328  void push_sym(environment *env, const ch Line 358  void push_sym(environment *env, const ch
358    char *mangled;                /* Mangled function name */    char *mangled;                /* Mangled function name */
359    
360    new_value= new_val(env);    new_value= new_val(env);
361      protect(new_value);
362      new_fvalue= new_val(env);
363      protect(new_fvalue);
364    
365    /* The new value is a symbol */    /* The new value is a symbol */
366    new_value->type= symb;    new_value->type= symb;
# Line 355  void push_sym(environment *env, const ch Line 388  void push_sym(environment *env, const ch
388    
389      mangled= mangle_str(in_string); /* mangle the name */      mangled= mangle_str(in_string); /* mangle the name */
390      funcptr= dlsym(handle, mangled); /* and try to find it */      funcptr= dlsym(handle, mangled); /* and try to find it */
391      free(mangled);  
392      dlerr= dlerror();      dlerr= dlerror();
393      if(dlerr != NULL) {         /* If no function was found */      if(dlerr != NULL) {         /* If no function was found */
394        funcptr= dlsym(handle, in_string); /* Get function pointer */        funcptr= dlsym(handle, in_string); /* Get function pointer */
395        dlerr= dlerror();        dlerr= dlerror();
396      }      }
397    
398      if(dlerr==NULL) {           /* If a function was found */      if(dlerr==NULL) {           /* If a function was found */
       new_fvalue= new_val(env); /* Create a new value */  
399        new_fvalue->type= func;   /* The new value is a function pointer */        new_fvalue->type= func;   /* The new value is a function pointer */
400        new_fvalue->content.ptr= funcptr; /* Store function pointer */        new_fvalue->content.ptr= funcptr; /* Store function pointer */
401        (*new_symbol)->val= new_fvalue; /* Bind the symbol to the new        (*new_symbol)->val= new_fvalue; /* Bind the symbol to the new
402                                           function value */                                           function value */
403      }      }
404    
405        free(mangled);
406    }    }
407    
408    push_val(env, new_value);    push_val(env, new_value);
409      unprotect(new_value); unprotect(new_fvalue);
410  }  }
411    
412  /* Print newline. */  /* Print newline. */
# Line 379  extern void nl() Line 416  extern void nl()
416  }  }
417    
418  /* Gets the type of a value */  /* Gets the type of a value */
419  extern void type(environment *env){  extern void type(environment *env)
420    {
421    int typenum;    int typenum;
422    
423    if((env->head)==NULL) {    if(env->head==NULL) {
424      printerr("Too Few Arguments");      printerr("Too Few Arguments");
425      env->err=1;      env->err= 1;
426      return;      return;
427    }    }
428    typenum=env->head->item->type;  
429      typenum= CAR(env->head)->type;
430    toss(env);    toss(env);
431    switch(typenum){    switch(typenum){
432    case integer:    case integer:
433      push_sym(env, "integer");      push_sym(env, "integer");
434      break;      break;
435      case tfloat:
436        push_sym(env, "float");
437        break;
438    case string:    case string:
439      push_sym(env, "string");      push_sym(env, "string");
440      break;      break;
# Line 402  extern void type(environment *env){ Line 444  extern void type(environment *env){
444    case func:    case func:
445      push_sym(env, "function");      push_sym(env, "function");
446      break;      break;
447    case list:    case tcons:
448      push_sym(env, "list");      push_sym(env, "list");
449      break;      break;
450    }    }
451  }      }    
452    
453  /* Prints the top element of the stack. */  /* Prints the top element of the stack. */
454  void print_h(stackitem *stack_head, int noquote)  void print_h(value *stack_head, int noquote)
455  {  {
456    switch(stack_head->item->type) {    switch(CAR(stack_head)->type) {
457    case integer:    case integer:
458      printf("%d", stack_head->item->content.val);      printf("%d", CAR(stack_head)->content.i);
459        break;
460      case tfloat:
461        printf("%f", CAR(stack_head)->content.f);
462      break;      break;
463    case string:    case string:
464      if(noquote)      if(noquote)
465        printf("%s", (char*)stack_head->item->content.ptr);        printf("%s", (char*)CAR(stack_head)->content.ptr);
466      else      else
467        printf("\"%s\"", (char*)stack_head->item->content.ptr);        printf("\"%s\"", (char*)CAR(stack_head)->content.ptr);
468      break;      break;
469    case symb:    case symb:
470      printf("%s", ((symbol *)(stack_head->item->content.ptr))->id);      printf("%s", CAR(stack_head)->content.sym->id);
471      break;      break;
472    case func:    case func:
473      printf("#<function %p>", (funcp)(stack_head->item->content.ptr));      printf("#<function %p>", (funcp)(CAR(stack_head)->content.ptr));
474      break;      break;
475    case list:    case tcons:
476      /* 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 */
477      stack_head=(stackitem *)(stack_head->item->content.ptr);      stack_head= CAR(stack_head);
478      printf("[ ");      printf("[ ");
479      while(stack_head != NULL) {      while(stack_head != NULL) {
480        print_h(stack_head, noquote);        print_h(stack_head, noquote);
481        printf(" ");        printf(" ");
482        stack_head=stack_head->next;        stack_head= CDR(stack_head);
483      }      }
484      printf("]");      printf("]");
485      break;      break;
486    }    }
487  }  }
488    
489  extern void print_(environment *env) {  extern void print_(environment *env)
490    {
491    if(env->head==NULL) {    if(env->head==NULL) {
492      printerr("Too Few Arguments");      printerr("Too Few Arguments");
493      env->err=1;      env->err= 1;
494      return;      return;
495    }    }
496    print_h(env->head, 0);    print_h(env->head, 0);
# Line 459  extern void print(environment *env) Line 505  extern void print(environment *env)
505    toss(env);    toss(env);
506  }  }
507    
508  extern void princ_(environment *env) {  extern void princ_(environment *env)
509    {
510    if(env->head==NULL) {    if(env->head==NULL) {
511      printerr("Too Few Arguments");      printerr("Too Few Arguments");
512      env->err=1;      env->err= 1;
513      return;      return;
514    }    }
515    print_h(env->head, 1);    print_h(env->head, 1);
# Line 477  extern void princ(environment *env) Line 524  extern void princ(environment *env)
524  }  }
525    
526  /* Only to be called by function printstack. */  /* Only to be called by function printstack. */
527  void print_st(stackitem *stack_head, long counter)  void print_st(value *stack_head, long counter)
528  {  {
529    if(stack_head->next != NULL)    if(CDR(stack_head) != NULL)
530      print_st(stack_head->next, counter+1);      print_st(CDR(stack_head), counter+1);
531    printf("%ld: ", counter);    printf("%ld: ", counter);
532    print_h(stack_head, 0);    print_h(stack_head, 0);
533    nl();    nl();
# Line 493  extern void printstack(environment *env) Line 540  extern void printstack(environment *env)
540      printf("Stack Empty\n");      printf("Stack Empty\n");
541      return;      return;
542    }    }
543    
544    print_st(env->head, 1);    print_st(env->head, 1);
545  }  }
546    
547  /* Swap the two top elements on the stack. */  /* Swap the two top elements on the stack. */
548  extern void swap(environment *env)  extern void swap(environment *env)
549  {  {
550    stackitem *temp= env->head;    value *temp= env->head;
551        
552    if(env->head==NULL || env->head->next==NULL) {    if(env->head==NULL || CDR(env->head)==NULL) {
553      printerr("Too Few Arguments");      printerr("Too Few Arguments");
554      env->err=1;      env->err=1;
555      return;      return;
556    }    }
557    
558    env->head= env->head->next;    env->head= CDR(env->head);
559    temp->next= env->head->next;    CDR(temp)= CDR(env->head);
560    env->head->next= temp;    CDR(env->head)= temp;
561  }  }
562    
563  /* Rotate the first three elements on the stack. */  /* Rotate the first three elements on the stack. */
564  extern void rot(environment *env)  extern void rot(environment *env)
565  {  {
566    stackitem *temp= env->head;    value *temp= env->head;
567        
568    if(env->head==NULL || env->head->next==NULL    if(env->head==NULL || CDR(env->head)==NULL
569        || env->head->next->next==NULL) {       || CDR(CDR(env->head))==NULL) {
570      printerr("Too Few Arguments");      printerr("Too Few Arguments");
571      env->err=1;      env->err= 1;
572      return;      return;
573    }    }
574      
575    env->head= env->head->next->next;    env->head= CDR(CDR(env->head));
576    temp->next->next= env->head->next;    CDR(CDR(temp))= CDR(env->head);
577    env->head->next= temp;    CDR(env->head)= temp;
578  }  }
579    
580  /* Recall a value from a symbol, if bound */  /* Recall a value from a symbol, if bound */
# Line 534  extern void rcl(environment *env) Line 582  extern void rcl(environment *env)
582  {  {
583    value *val;    value *val;
584    
585    if(env->head == NULL) {    if(env->head==NULL) {
586      printerr("Too Few Arguments");      printerr("Too Few Arguments");
587      env->err=1;      env->err= 1;
588      return;      return;
589    }    }
590    
591    if(env->head->item->type!=symb) {    if(CAR(env->head)->type!=symb) {
592      printerr("Bad Argument Type");      printerr("Bad Argument Type");
593      env->err=2;      env->err= 2;
594      return;      return;
595    }    }
596    
597    val=((symbol *)(env->head->item->content.ptr))->val;    val= CAR(env->head)->content.sym->val;
598    if(val == NULL){    if(val == NULL){
599      printerr("Unbound Variable");      printerr("Unbound Variable");
600      env->err=3;      env->err= 3;
601      return;      return;
602    }    }
603    protect(env, val);    protect(val);
604    toss(env);            /* toss the symbol */    toss(env);            /* toss the symbol */
605    if(env->err) return;    if(env->err) return;
606    push_val(env, val); /* Return its bound value */    push_val(env, val); /* Return its bound value */
607    unprotect(env);    unprotect(val);
608  }  }
609    
610  /* 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 566  extern void eval(environment *env) Line 614  extern void eval(environment *env)
614  {  {
615    funcp in_func;    funcp in_func;
616    value* temp_val;    value* temp_val;
617    stackitem* iterator;    value* iterator;
618    
619   eval_start:   eval_start:
620    
621      gc_maybe(env);
622    
623    if(env->head==NULL) {    if(env->head==NULL) {
624      printerr("Too Few Arguments");      printerr("Too Few Arguments");
625      env->err=1;      env->err= 1;
626      return;      return;
627    }    }
628    
629    switch(env->head->item->type) {    switch(CAR(env->head)->type) {
630      /* if it's a symbol */      /* if it's a symbol */
631    case symb:    case symb:
632      rcl(env);                   /* get its contents */      rcl(env);                   /* get its contents */
633      if(env->err) return;      if(env->err) return;
634      if(env->head->item->type!=symb){ /* don't recurse symbols */      if(CAR(env->head)->type!=symb){ /* don't recurse symbols */
635        goto eval_start;        goto eval_start;
636      }      }
637      return;      return;
638    
639      /* If it's a lone function value, run it */      /* If it's a lone function value, run it */
640    case func:    case func:
641      in_func= (funcp)(env->head->item->content.ptr);      in_func= (funcp)(CAR(env->head)->content.ptr);
642      toss(env);      toss(env);
643      if(env->err) return;      if(env->err) return;
644      return in_func(env);      return in_func(env);
645    
646      /* If it's a list */      /* If it's a list */
647    case list:    case tcons:
648      temp_val= env->head->item;      temp_val= CAR(env->head);
649      protect(env, temp_val);      protect(temp_val);
650      toss(env);  
651      if(env->err) return;      toss(env); if(env->err) return;
652      iterator= (stackitem*)temp_val->content.ptr;      iterator= temp_val;
     unprotect(env);  
653            
654      while(iterator!=NULL) {      while(iterator!=NULL) {
655        push_val(env, iterator->item);        push_val(env, CAR(iterator));
656                
657        if(env->head->item->type==symb        if(CAR(env->head)->type==symb
658          && strcmp(";", ((symbol*)(env->head->item->content.ptr))->id)==0) {           && CAR(env->head)->content.sym->id[0]==';') {
659          toss(env);          toss(env);
660          if(env->err) return;          if(env->err) return;
661                    
662          if(iterator->next == NULL){          if(CDR(iterator)==NULL){
663            goto eval_start;            goto eval_start;
664          }          }
665          eval(env);          eval(env);
666          if(env->err) return;          if(env->err) return;
667        }        }
668        iterator= iterator->next;        if (CDR(iterator)->type == tcons)
669            iterator= CDR(iterator);
670          else {
671            printerr("Bad Argument Type"); /* Improper list */
672            env->err= 2;
673            return;
674          }
675      }      }
676        unprotect(temp_val);
677      return;      return;
678    
679    default:    default:
# Line 626  extern void eval(environment *env) Line 682  extern void eval(environment *env)
682  }  }
683    
684  /* Reverse (flip) a list */  /* Reverse (flip) a list */
685  extern void rev(environment *env){  extern void rev(environment *env)
686    stackitem *old_head, *new_head, *item;  {
687      value *old_head, *new_head, *item;
688    
689    if((env->head)==NULL) {    if(env->head==NULL) {
690      printerr("Too Few Arguments");      printerr("Too Few Arguments");
691      env->err= 1;      env->err= 1;
692      return;      return;
693    }    }
694    
695    if(env->head->item->type!=list) {    if(CAR(env->head)->type!=tcons) {
696      printerr("Bad Argument Type");      printerr("Bad Argument Type");
697      env->err= 2;      env->err= 2;
698      return;      return;
699    }    }
700    
701    old_head= (stackitem *)(env->head->item->content.ptr);    old_head= CAR(env->head);
702    new_head= NULL;    new_head= NULL;
703    while(old_head != NULL){    while(old_head!=NULL) {
704      item= old_head;      item= old_head;
705      old_head= old_head->next;      old_head= CDR(old_head);
706      item->next= new_head;      CDR(item)= new_head;
707      new_head= item;      new_head= item;
708    }    }
709    env->head->item->content.ptr= new_head;    CAR(env->head)= new_head;
710  }  }
711    
712  /* Make a list. */  /* Make a list. */
713  extern void pack(environment *env)  extern void pack(environment *env)
714  {  {
715    stackitem *iterator, *temp;    value *iterator, *temp;
   value *pack;  
716    
717    iterator= env->head;    iterator= env->head;
   
718    if(iterator==NULL    if(iterator==NULL
719       || (iterator->item->type==symb       || (CAR(iterator)->type==symb
720       && ((symbol*)(iterator->item->content.ptr))->id[0]=='[')) {       && CAR(iterator)->content.sym->id[0]=='[')) {
721      temp= NULL;      temp= NULL;
722      toss(env);      toss(env);
723    } else {    } else {
724      /* Search for first delimiter */      /* Search for first delimiter */
725      while(iterator->next!=NULL      while(CDR(iterator)!=NULL
726            && (iterator->next->item->type!=symb            && (CAR(CDR(iterator))->type!=symb
727            || ((symbol*)(iterator->next->item->content.ptr))->id[0]!='['))             || CAR(CDR(iterator))->content.sym->id[0]!='['))
728        iterator= iterator->next;        iterator= CDR(iterator);
729            
730      /* Extract list */      /* Extract list */
731      temp= env->head;      temp= env->head;
732      env->head= iterator->next;      env->head= CDR(iterator);
733      iterator->next= NULL;      CDR(iterator)= NULL;
734        
735      if(env->head!=NULL)      if(env->head!=NULL)
736        toss(env);        toss(env);
737    }    }
738    
739    /* Push list */    /* Push list */
   pack= new_val(env);  
   pack->type= list;  
   pack->content.ptr= temp;  
740    
741    push_val(env, pack);    push_val(env, temp);
742    rev(env);    rev(env);
743  }  }
744    
745  /* Relocate elements of the list on the stack. */  /* Relocate elements of the list on the stack. */
746  extern void expand(environment *env)  extern void expand(environment *env)
747  {  {
748    stackitem *temp, *new_head;    value *temp, *new_head;
749    
750    /* Is top element a list? */    /* Is top element a list? */
751    if(env->head==NULL) {    if(env->head==NULL) {
# Line 701  extern void expand(environment *env) Line 753  extern void expand(environment *env)
753      env->err= 1;      env->err= 1;
754      return;      return;
755    }    }
756    if(env->head->item->type!=list) {  
757      if(CAR(env->head)->type!=tcons) {
758      printerr("Bad Argument Type");      printerr("Bad Argument Type");
759      env->err= 2;      env->err= 2;
760      return;      return;
# Line 713  extern void expand(environment *env) Line 766  extern void expand(environment *env)
766      return;      return;
767    
768    /* The first list element is the new stack head */    /* The first list element is the new stack head */
769    new_head= temp= env->head->item->content.ptr;    new_head= temp= CAR(env->head);
770    
771    toss(env);    toss(env);
772    
773    /* Find the end of the list */    /* Find the end of the list */
774    while(temp->next!=NULL)    while(CDR(temp)->content.ptr != NULL) {
775      temp= temp->next;      if (CDR(temp)->type == tcons)
776          temp= CDR(temp);
777        else {
778          printerr("Bad Argument Type"); /* Improper list */
779          env->err= 2;
780          return;
781        }
782      }
783    
784    /* Connect the tail of the list with the old stack head */    /* Connect the tail of the list with the old stack head */
785    temp->next= env->head;    CDR(temp)= env->head;
786    env->head= new_head;          /* ...and voila! */    env->head= new_head;          /* ...and voila! */
787    
788  }  }
# Line 731  extern void expand(environment *env) Line 791  extern void expand(environment *env)
791  extern void eq(environment *env)  extern void eq(environment *env)
792  {  {
793    void *left, *right;    void *left, *right;
   int result;  
794    
795    if((env->head)==NULL || env->head->next==NULL) {    if(env->head==NULL || CDR(env->head)==NULL) {
796      printerr("Too Few Arguments");      printerr("Too Few Arguments");
797      env->err= 1;      env->err= 1;
798      return;      return;
799    }    }
800    
801    left= env->head->item->content.ptr;    left= CAR(env->head)->content.ptr;
802    swap(env);    right= CAR(CDR(env->head))->content.ptr;
   right= env->head->item->content.ptr;  
   result= (left==right);  
     
803    toss(env); toss(env);    toss(env); toss(env);
804    push_int(env, result);  
805      push_int(env, left==right);
806  }  }
807    
808  /* Negates the top element on the stack. */  /* Negates the top element on the stack. */
# Line 753  extern void not(environment *env) Line 810  extern void not(environment *env)
810  {  {
811    int val;    int val;
812    
813    if((env->head)==NULL) {    if(env->head==NULL) {
814      printerr("Too Few Arguments");      printerr("Too Few Arguments");
815      env->err= 1;      env->err= 1;
816      return;      return;
817    }    }
818    
819    if(env->head->item->type!=integer) {    if(CAR(env->head)->type!=integer) {
820      printerr("Bad Argument Type");      printerr("Bad Argument Type");
821      env->err= 2;      env->err= 2;
822      return;      return;
823    }    }
824    
825    val= env->head->item->content.val;    val= CAR(env->head)->content.i;
826    toss(env);    toss(env);
827    push_int(env, !val);    push_int(env, !val);
828  }  }
# Line 784  extern void def(environment *env) Line 841  extern void def(environment *env)
841    symbol *sym;    symbol *sym;
842    
843    /* 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 */
844    if(env->head==NULL || env->head->next==NULL) {    if(env->head==NULL || CDR(env->head)==NULL) {
845      printerr("Too Few Arguments");      printerr("Too Few Arguments");
846      env->err= 1;      env->err= 1;
847      return;      return;
848    }    }
849    
850    if(env->head->item->type!=symb) {    if(CAR(env->head)->type!=symb) {
851      printerr("Bad Argument Type");      printerr("Bad Argument Type");
852      env->err= 2;      env->err= 2;
853      return;      return;
854    }    }
855    
856    /* long names are a pain */    /* long names are a pain */
857    sym= env->head->item->content.ptr;    sym= CAR(env->head)->content.ptr;
858    
859    /* Bind the symbol to the value */    /* Bind the symbol to the value */
860    sym->val= env->head->next->item;    sym->val= CAR(CDR(env->head));
861    
862    toss(env); toss(env);    toss(env); toss(env);
863  }  }
# Line 808  extern void def(environment *env) Line 865  extern void def(environment *env)
865  /* Quit stack. */  /* Quit stack. */
866  extern void quit(environment *env)  extern void quit(environment *env)
867  {  {
868    long i;    int i;
869    
870    clear(env);    clear(env);
871    
# Line 821  extern void quit(environment *env) Line 878  extern void quit(environment *env)
878    }    }
879    
880    env->gc_limit= 0;    env->gc_limit= 0;
881    gc_init(env);    gc_maybe(env);
882    
883    if(env->free_string!=NULL)    if(env->free_string!=NULL)
884      free(env->free_string);      free(env->free_string);
# Line 854  extern void words(environment *env) Line 911  extern void words(environment *env)
911  }  }
912    
913  /* Internal forget function */  /* Internal forget function */
914  void forget_sym(symbol **hash_entry) {  void forget_sym(symbol **hash_entry)
915    {
916    symbol *temp;    symbol *temp;
917    
918    temp= *hash_entry;    temp= *hash_entry;
# Line 868  void forget_sym(symbol **hash_entry) { Line 926  void forget_sym(symbol **hash_entry) {
926  extern void forget(environment *env)  extern void forget(environment *env)
927  {  {
928    char* sym_id;    char* sym_id;
929    stackitem *stack_head= env->head;    value *stack_head= env->head;
930    
931    if(stack_head==NULL) {    if(stack_head==NULL) {
932      printerr("Too Few Arguments");      printerr("Too Few Arguments");
933      env->err=1;      env->err= 1;
934      return;      return;
935    }    }
936        
937    if(stack_head->item->type!=symb) {    if(CAR(stack_head)->type!=symb) {
938      printerr("Bad Argument Type");      printerr("Bad Argument Type");
939      env->err=2;      env->err= 2;
940      return;      return;
941    }    }
942    
943    sym_id= ((symbol*)(stack_head->item->content.ptr))->id;    sym_id= CAR(stack_head)->content.sym->id;
944    toss(env);    toss(env);
945    
946    return forget_sym(hash(env->symbols, sym_id));    return forget_sym(hash(env->symbols, sym_id));
947  }  }
948    
949  /* Returns the current error number to the stack */  /* Returns the current error number to the stack */
950  extern void errn(environment *env){  extern void errn(environment *env)
951    {
952    push_int(env, env->err);    push_int(env, env->err);
953  }  }
954    
# Line 953  under certain conditions; type `copying; Line 1012  under certain conditions; type `copying;
1012      if (myenv.err==4) {      if (myenv.err==4) {
1013        return EXIT_SUCCESS;      /* EOF */        return EXIT_SUCCESS;      /* EOF */
1014      } else if(myenv.head!=NULL      } else if(myenv.head!=NULL
1015                && myenv.head->item->type==symb                && CAR(myenv.head)->type==symb
1016                && ((symbol*)(myenv.head->item->content.ptr))->id[0]==';') {                && CAR(myenv.head)->content.sym->id[0]
1017                  ==';') {
1018        toss(&myenv);             /* No error check in main */        toss(&myenv);             /* No error check in main */
1019        eval(&myenv);        eval(&myenv);
1020      }      }
1021      gc_init(&myenv);      gc_maybe(&myenv);
1022    }    }
1023    quit(&myenv);    quit(&myenv);
1024    return EXIT_FAILURE;    return EXIT_FAILURE;
1025  }  }
1026    
1027  /* "+" */  /* "+" */
1028  extern void sx_2b(environment *env) {  extern void sx_2b(environment *env)
1029    {
1030    int a, b;    int a, b;
1031      float fa, fb;
1032    size_t len;    size_t len;
1033    char* new_string;    char* new_string;
1034    value *a_val, *b_val;    value *a_val, *b_val;
1035    
1036    if((env->head)==NULL || env->head->next==NULL) {    if(env->head==NULL || CDR(env->head)==NULL) {
1037      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1038      env->err= 1;      env->err= 1;
1039      return;      return;
1040    }    }
1041    
1042    if(env->head->item->type==string    if(CAR(env->head)->type==string
1043       && env->head->next->item->type==string) {       && CAR(CDR(env->head))->type==string) {
1044      a_val= env->head->item;      a_val= CAR(env->head);
1045      b_val= env->head->next->item;      b_val= CAR(CDR(env->head));
1046      protect(env, a_val); protect(env, b_val);      protect(a_val); protect(b_val);
1047      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1048      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1049      len= strlen(a_val->content.ptr)+strlen(b_val->content.ptr)+1;      len= strlen(a_val->content.ptr)+strlen(b_val->content.ptr)+1;
# Line 989  extern void sx_2b(environment *env) { Line 1051  extern void sx_2b(environment *env) {
1051      strcpy(new_string, b_val->content.ptr);      strcpy(new_string, b_val->content.ptr);
1052      strcat(new_string, a_val->content.ptr);      strcat(new_string, a_val->content.ptr);
1053      push_cstring(env, new_string);      push_cstring(env, new_string);
1054      unprotect(env); unprotect(env);      unprotect(a_val); unprotect(b_val);
1055      free(new_string);      free(new_string);
1056        
1057      return;      return;
1058    }    }
1059        
1060    if(env->head->item->type!=integer    if(CAR(env->head)->type==integer
1061       || env->head->next->item->type!=integer) {       && CAR(CDR(env->head))->type==integer) {
1062      printerr("Bad Argument Type");      a= CAR(env->head)->content.i;
1063      env->err=2;      toss(env); if(env->err) return;
1064        b= CAR(env->head)->content.i;
1065        toss(env); if(env->err) return;
1066        push_int(env, b+a);
1067    
1068      return;      return;
1069    }    }
1070    a= env->head->item->content.val;  
1071    toss(env); if(env->err) return;    if(CAR(env->head)->type==tfloat
1072           && CAR(CDR(env->head))->type==tfloat) {
1073    b= env->head->item->content.val;      fa= CAR(env->head)->content.f;
1074    toss(env); if(env->err) return;      toss(env); if(env->err) return;
1075    push_int(env, a+b);      fb= CAR(env->head)->content.f;
1076        toss(env); if(env->err) return;
1077        push_float(env, fb+fa);
1078        
1079        return;
1080      }
1081    
1082      if(CAR(env->head)->type==tfloat
1083         && CAR(CDR(env->head))->type==integer) {
1084        fa= CAR(env->head)->content.f;
1085        toss(env); if(env->err) return;
1086        b= CAR(env->head)->content.i;
1087        toss(env); if(env->err) return;
1088        push_float(env, b+fa);
1089        
1090        return;
1091      }
1092    
1093      if(CAR(env->head)->type==integer
1094         && CAR(CDR(env->head))->type==tfloat) {
1095        a= CAR(env->head)->content.i;
1096        toss(env); if(env->err) return;
1097        fb= CAR(env->head)->content.f;
1098        toss(env); if(env->err) return;
1099        push_float(env, fb+a);
1100    
1101        return;
1102      }
1103    
1104      printerr("Bad Argument Type");
1105      env->err=2;
1106  }  }
1107    
1108  /* "-" */  /* "-" */
1109  extern void sx_2d(environment *env) {  extern void sx_2d(environment *env)
1110    {
1111    int a, b;    int a, b;
1112      float fa, fb;
1113    
1114    if((env->head)==NULL || env->head->next==NULL) {    if(env->head==NULL || CDR(env->head)==NULL) {
1115      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1116      env->err=1;      env->err=1;
1117      return;      return;
1118    }    }
1119        
1120    if(env->head->item->type!=integer    if(CAR(env->head)->type==integer
1121       || env->head->next->item->type!=integer) {       && CAR(CDR(env->head))->type==integer) {
1122      printerr("Bad Argument Type");      a= CAR(env->head)->content.i;
1123      env->err=2;      toss(env); if(env->err) return;
1124        b= CAR(env->head)->content.i;
1125        toss(env); if(env->err) return;
1126        push_int(env, b-a);
1127    
1128      return;      return;
1129    }    }
1130    
1131    a=env->head->item->content.val;    if(CAR(env->head)->type==tfloat
1132    toss(env); if(env->err) return;       && CAR(CDR(env->head))->type==tfloat) {
1133    b=env->head->item->content.val;      fa= CAR(env->head)->content.f;
1134    toss(env); if(env->err) return;      toss(env); if(env->err) return;
1135    push_int(env, b-a);      fb= CAR(env->head)->content.f;
1136        toss(env); if(env->err) return;
1137        push_float(env, fb-fa);
1138        
1139        return;
1140      }
1141    
1142      if(CAR(env->head)->type==tfloat
1143         && CAR(CDR(env->head))->type==integer) {
1144        fa= CAR(env->head)->content.f;
1145        toss(env); if(env->err) return;
1146        b= CAR(env->head)->content.i;
1147        toss(env); if(env->err) return;
1148        push_float(env, b-fa);
1149        
1150        return;
1151      }
1152    
1153      if(CAR(env->head)->type==integer
1154         && CAR(CDR(env->head))->type==tfloat) {
1155        a= CAR(env->head)->content.i;
1156        toss(env); if(env->err) return;
1157        fb= CAR(env->head)->content.f;
1158        toss(env); if(env->err) return;
1159        push_float(env, fb-a);
1160    
1161        return;
1162      }
1163    
1164      printerr("Bad Argument Type");
1165      env->err=2;
1166  }  }
1167    
1168  /* ">" */  /* ">" */
1169  extern void sx_3e(environment *env) {  extern void sx_3e(environment *env)
1170    {
1171    int a, b;    int a, b;
1172      float fa, fb;
1173    
1174    if((env->head)==NULL || env->head->next==NULL) {    if(env->head==NULL || CDR(env->head)==NULL) {
1175      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1176      env->err=1;      env->err= 1;
1177      return;      return;
1178    }    }
1179        
1180    if(env->head->item->type!=integer    if(CAR(env->head)->type==integer
1181       || env->head->next->item->type!=integer) {       && CAR(CDR(env->head))->type==integer) {
1182      printerr("Bad Argument Type");      a= CAR(env->head)->content.i;
1183      env->err=2;      toss(env); if(env->err) return;
1184        b= CAR(env->head)->content.i;
1185        toss(env); if(env->err) return;
1186        push_int(env, b>a);
1187    
1188      return;      return;
1189    }    }
1190    
1191    a=env->head->item->content.val;    if(CAR(env->head)->type==tfloat
1192    toss(env); if(env->err) return;       && CAR(CDR(env->head))->type==tfloat) {
1193    b=env->head->item->content.val;      fa= CAR(env->head)->content.f;
1194    toss(env); if(env->err) return;      toss(env); if(env->err) return;
1195    push_int(env, b>a);      fb= CAR(env->head)->content.f;
1196        toss(env); if(env->err) return;
1197        push_int(env, fb>fa);
1198        
1199        return;
1200      }
1201    
1202      if(CAR(env->head)->type==tfloat
1203         && CAR(CDR(env->head))->type==integer) {
1204        fa= CAR(env->head)->content.f;
1205        toss(env); if(env->err) return;
1206        b= CAR(env->head)->content.i;
1207        toss(env); if(env->err) return;
1208        push_int(env, b>fa);
1209        
1210        return;
1211      }
1212    
1213      if(CAR(env->head)->type==integer
1214         && CAR(CDR(env->head))->type==tfloat) {
1215        a= CAR(env->head)->content.i;
1216        toss(env); if(env->err) return;
1217        fb= CAR(env->head)->content.f;
1218        toss(env); if(env->err) return;
1219        push_int(env, fb>a);
1220    
1221        return;
1222      }
1223    
1224      printerr("Bad Argument Type");
1225      env->err= 2;
1226    }
1227    
1228    /* "<" */
1229    extern void sx_3c(environment *env)
1230    {
1231      swap(env); if(env->err) return;
1232      sx_3e(env);
1233    }
1234    
1235    /* "<=" */
1236    extern void sx_3c3d(environment *env)
1237    {
1238      sx_3e(env); if(env->err) return;
1239      not(env);
1240    }
1241    
1242    /* ">=" */
1243    extern void sx_3e3d(environment *env)
1244    {
1245      sx_3c(env); if(env->err) return;
1246      not(env);
1247  }  }
1248    
1249  /* Return copy of a value */  /* Return copy of a value */
1250  value *copy_val(environment *env, value *old_value){  value *copy_val(environment *env, value *old_value)
1251    stackitem *old_item, *new_item, *prev_item;  {
1252      value *new_value;
1253    
1254    value *new_value= new_val(env);    if(old_value==NULL)
1255        return NULL;
1256    
1257    protect(env, old_value);    protect(old_value);
1258      new_value= new_val(env);
1259      protect(new_value);
1260    new_value->type= old_value->type;    new_value->type= old_value->type;
1261    
1262    switch(old_value->type){    switch(old_value->type){
1263      case tfloat:
1264    case integer:    case integer:
1265      new_value->content.val= old_value->content.val;    case func:
1266      case symb:
1267        new_value->content= old_value->content;
1268      break;      break;
1269    case string:    case string:
1270      (char *)(new_value->content.ptr)=      (char *)(new_value->content.ptr)=
1271        strdup((char *)(old_value->content.ptr));        strdup((char *)(old_value->content.ptr));
1272      break;      break;
1273    case func:    case tcons:
1274    case symb:      new_value= NULL;
     new_value->content.ptr= old_value->content.ptr;  
     break;  
   case list:  
     new_value->content.ptr= NULL;  
1275    
1276      prev_item= NULL;      new_value->content.c= malloc(sizeof(cons));
1277      old_item= (stackitem*)(old_value->content.ptr);      CAR(new_value)= copy_val(env, CAR(old_value)); /* recurse */
1278        CDR(new_value)= copy_val(env, CDR(old_value)); /* recurse */
     while(old_item != NULL) {   /* While list is not empty */  
       new_item= malloc(sizeof(stackitem));  
       new_item->item= copy_val(env, old_item->item); /* recurse */  
       new_item->next= NULL;  
       if(prev_item != NULL)     /* If this wasn't the first item */  
         prev_item->next= new_item; /* point the previous item to the  
                                      new item */  
       else  
         new_value->content.ptr= new_item;  
       old_item= old_item->next;  
       prev_item= new_item;  
     }      
1279      break;      break;
1280    }    }
1281    
1282    unprotect(env);    unprotect(old_value); unprotect(new_value);
1283    
1284    return new_value;    return new_value;
1285  }  }
1286    
1287  /* "dup"; duplicates an item on the stack */  /* "dup"; duplicates an item on the stack */
1288  extern void sx_647570(environment *env) {  extern void sx_647570(environment *env)
1289    if((env->head)==NULL) {  {
1290      if(env->head==NULL) {
1291      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1292      env->err= 1;      env->err= 1;
1293      return;      return;
1294    }    }
1295    push_val(env, copy_val(env, env->head->item));    push_val(env, copy_val(env, CAR(env->head)));
1296  }  }
1297    
1298  /* "if", If-Then */  /* "if", If-Then */
1299  extern void sx_6966(environment *env) {  extern void sx_6966(environment *env)
1300    {
1301    int truth;    int truth;
1302    
1303    if((env->head)==NULL || env->head->next==NULL) {    if(env->head==NULL || CDR(env->head)==NULL) {
1304      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1305      env->err= 1;      env->err= 1;
1306      return;      return;
1307    }    }
1308    
1309    if(env->head->next->item->type != integer) {    if(CAR(CDR(env->head))->type != integer) {
1310      printerr("Bad Argument Type");      printerr("Bad Argument Type");
1311      env->err=2;      env->err= 2;
1312      return;      return;
1313    }    }
1314        
1315    swap(env);    swap(env);
1316    if(env->err) return;    if(env->err) return;
1317        
1318    truth=env->head->item->content.val;    truth= CAR(env->head)->content.i;
1319    
1320    toss(env);    toss(env);
1321    if(env->err) return;    if(env->err) return;
# Line 1145  extern void sx_6966(environment *env) { Line 1327  extern void sx_6966(environment *env) {
1327  }  }
1328    
1329  /* If-Then-Else */  /* If-Then-Else */
1330  extern void ifelse(environment *env) {  extern void ifelse(environment *env)
1331    {
1332    int truth;    int truth;
1333    
1334    if((env->head)==NULL || env->head->next==NULL    if(env->head==NULL || CDR(env->head)==NULL
1335       || env->head->next->next==NULL) {       || CDR(CDR(env->head))==NULL) {
1336      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1337      env->err=1;      env->err= 1;
1338      return;      return;
1339    }    }
1340    
1341    if(env->head->next->next->item->type != integer) {    if(CAR(CDR(CDR(env->head)))->type!=integer) {
1342      printerr("Bad Argument Type");      printerr("Bad Argument Type");
1343      env->err=2;      env->err= 2;
1344      return;      return;
1345    }    }
1346        
1347    rot(env);    rot(env);
1348    if(env->err) return;    if(env->err) return;
1349        
1350    truth=env->head->item->content.val;    truth= CAR(env->head)->content.i;
1351    
1352    toss(env);    toss(env);
1353    if(env->err) return;    if(env->err) return;
# Line 1180  extern void ifelse(environment *env) { Line 1362  extern void ifelse(environment *env) {
1362    eval(env);    eval(env);
1363  }  }
1364    
1365  /* "while" */  extern void sx_656c7365(environment *env)
1366  extern void sx_7768696c65(environment *env) {  {
1367      if(env->head==NULL || CDR(env->head)==NULL
1368         || CDR(CDR(env->head))==NULL || CDR(CDR(CDR(env->head)))==NULL) {
1369        printerr("Too Few Arguments");
1370        env->err= 1;
1371        return;
1372      }
1373    
1374      if(CAR(CDR(env->head))->type!=symb
1375         || strcmp(CAR(CDR(env->head))->content.sym->id, "if")!=0) {
1376        printerr("Bad Argument Type");
1377        env->err= 2;
1378        return;
1379      }
1380    
1381      swap(env); toss(env);
1382      ifelse(env);
1383    }
1384    
1385    /* "while" */
1386    extern void sx_7768696c65(environment *env)
1387    {
1388    int truth;    int truth;
1389    value *loop, *test;    value *loop, *test;
1390    
1391    if((env->head)==NULL || env->head->next==NULL) {    if(env->head==NULL || CDR(env->head)==NULL) {
1392      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1393      env->err=1;      env->err= 1;
1394      return;      return;
1395    }    }
1396    
1397    loop= env->head->item;    loop= CAR(env->head);
1398    protect(env, loop);    protect(loop);
1399    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1400    
1401    test= env->head->item;    test= CAR(env->head);
1402    protect(env, test);    protect(test);
1403    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1404    
1405    do {    do {
1406      push_val(env, test);      push_val(env, test);
1407      eval(env);      eval(env);
1408            
1409      if(env->head->item->type != integer) {      if(CAR(env->head)->type != integer) {
1410        printerr("Bad Argument Type");        printerr("Bad Argument Type");
1411        env->err= 2;        env->err= 2;
1412        return;        return;
1413      }      }
1414            
1415      truth= env->head->item->content.val;      truth= CAR(env->head)->content.i;
1416      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1417            
1418      if(truth) {      if(truth) {
# Line 1222  extern void sx_7768696c65(environment *e Line 1424  extern void sx_7768696c65(environment *e
1424        
1425    } while(truth);    } while(truth);
1426    
1427    unprotect(env); unprotect(env);    unprotect(loop); unprotect(test);
1428  }  }
1429    
1430    
1431  /* "for"; for-loop */  /* "for"; for-loop */
1432  extern void sx_666f72(environment *env) {  extern void sx_666f72(environment *env)
1433    {
1434    value *loop;    value *loop;
1435    int foo1, foo2;    int foo1, foo2;
1436    
1437    if(env->head==NULL || env->head->next==NULL    if(env->head==NULL || CDR(env->head)==NULL
1438       || env->head->next->next==NULL) {       || CDR(CDR(env->head))==NULL) {
1439      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1440      env->err= 1;      env->err= 1;
1441      return;      return;
1442    }    }
1443    
1444    if(env->head->next->item->type!=integer    if(CAR(CDR(env->head))->type!=integer
1445       || env->head->next->next->item->type!=integer) {       || CAR(CDR(CDR(env->head)))->type!=integer) {
1446      printerr("Bad Argument Type");      printerr("Bad Argument Type");
1447      env->err= 2;      env->err= 2;
1448      return;      return;
1449    }    }
1450    
1451    loop= env->head->item;    loop= CAR(env->head);
1452    protect(env, loop);    protect(loop);
1453    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1454    
1455    foo2= env->head->item->content.val;    foo2= CAR(env->head)->content.i;
1456    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1457    
1458    foo1= env->head->item->content.val;    foo1= CAR(env->head)->content.i;
1459    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1460    
1461    if(foo1<=foo2) {    if(foo1<=foo2) {
# Line 1270  extern void sx_666f72(environment *env) Line 1473  extern void sx_666f72(environment *env)
1473        foo1--;        foo1--;
1474      }      }
1475    }    }
1476    unprotect(env);    unprotect(loop);
1477  }  }
1478    
1479  /* Variant of for-loop */  /* Variant of for-loop */
1480  extern void foreach(environment *env) {  extern void foreach(environment *env)
1481      {  
1482    value *loop, *foo;    value *loop, *foo;
1483    stackitem *iterator;    value *iterator;
1484        
1485    if((env->head)==NULL || env->head->next==NULL) {    if(env->head==NULL || CDR(env->head)==NULL) {
1486      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1487      env->err= 1;      env->err= 1;
1488      return;      return;
1489    }    }
1490    
1491    if(env->head->next->item->type != list) {    if(CAR(CDR(env->head))->type!=tcons) {
1492      printerr("Bad Argument Type");      printerr("Bad Argument Type");
1493      env->err= 2;      env->err= 2;
1494      return;      return;
1495    }    }
1496    
1497    loop= env->head->item;    loop= CAR(env->head);
1498    protect(env, loop);    protect(loop);
1499    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1500    
1501    foo= env->head->item;    foo= CAR(env->head);
1502    protect(env, foo);    protect(foo);
1503    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1504    
1505    iterator= foo->content.ptr;    iterator= foo;
1506    
1507    while(iterator!=NULL) {    while(iterator!=NULL) {
1508      push_val(env, iterator->item);      push_val(env, CAR(iterator));
1509      push_val(env, loop);      push_val(env, loop);
1510      eval(env); if(env->err) return;      eval(env); if(env->err) return;
1511      iterator= iterator->next;      if (iterator->type == tcons){
1512          iterator= CDR(iterator);
1513        } else {
1514          printerr("Bad Argument Type"); /* Improper list */
1515          env->err= 2;
1516          break;
1517        }
1518    }    }
1519    unprotect(env); unprotect(env);    unprotect(loop); unprotect(foo);
1520  }  }
1521    
1522  /* "to" */  /* "to" */
1523  extern void to(environment *env) {  extern void to(environment *env)
1524    int i, start, ending;  {
1525    stackitem *temp_head;    int ending, start, i;
1526    value *temp_val;    value *iterator, *temp;
1527      
1528    if((env->head)==NULL || env->head->next==NULL) {    if(env->head==NULL || CDR(env->head)==NULL) {
1529      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1530      env->err=1;      env->err= 1;
1531      return;      return;
1532    }    }
1533    
1534    if(env->head->item->type!=integer    if(CAR(env->head)->type!=integer
1535       || env->head->next->item->type!=integer) {       || CAR(CDR(env->head))->type!=integer) {
1536      printerr("Bad Argument Type");      printerr("Bad Argument Type");
1537      env->err=2;      env->err= 2;
1538      return;      return;
1539    }    }
1540    
1541    ending= env->head->item->content.val;    ending= CAR(env->head)->content.i;
1542    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1543    start= env->head->item->content.val;    start= CAR(env->head)->content.i;
1544    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1545    
1546    temp_head= env->head;    push_sym(env, "[");
   env->head= NULL;  
1547    
1548    if(ending>=start) {    if(ending>=start) {
1549      for(i= ending; i>=start; i--)      for(i= ending; i>=start; i--)
# Line 1345  extern void to(environment *env) { Line 1553  extern void to(environment *env) {
1553        push_int(env, i);        push_int(env, i);
1554    }    }
1555    
1556    temp_val= new_val(env);    iterator= env->head;
1557    temp_val->content.ptr= env->head;  
1558    temp_val->type= list;    if(iterator==NULL
1559    env->head= temp_head;       || (CAR(iterator)->type==symb
1560    push_val(env, temp_val);           && CAR(iterator)->content.sym->id[0]=='[')) {
1561        temp= NULL;
1562        toss(env);
1563      } else {
1564        /* Search for first delimiter */
1565        while(CDR(iterator)!=NULL
1566              && (CAR(CDR(iterator))->type!=symb
1567                  || CAR(CDR(iterator))->content.sym->id[0]!='['))
1568          iterator= CDR(iterator);
1569        
1570        /* Extract list */
1571        temp= env->head;
1572        env->head= CDR(iterator);
1573        CDR(iterator)= NULL;
1574    
1575        if(env->head!=NULL)
1576          toss(env);
1577      }
1578    
1579      /* Push list */
1580      push_val(env, temp);
1581  }  }
1582    
1583  /* Read a string */  /* Read a string */
1584  extern void readline(environment *env) {  extern void readline(environment *env)
1585    {
1586    char in_string[101];    char in_string[101];
1587    
1588    if(fgets(in_string, 100, env->inputstream)==NULL)    if(fgets(in_string, 100, env->inputstream)==NULL)
# Line 1363  extern void readline(environment *env) { Line 1592  extern void readline(environment *env) {
1592  }  }
1593    
1594  /* "read"; Read a value and place on stack */  /* "read"; Read a value and place on stack */
1595  extern void sx_72656164(environment *env) {  extern void sx_72656164(environment *env)
1596    {
1597    const char symbform[]= "%[a-zA-Z0-9!$%*+./:<=>?@^_~-]%n";    const char symbform[]= "%[a-zA-Z0-9!$%*+./:<=>?@^_~-]%n";
1598    const char strform[]= "\"%[^\"]\"%n";    const char strform[]= "\"%[^\"]\"%n";
1599    const char intform[]= "%i%n";    const char intform[]= "%i%n";
1600      const char fltform[]= "%f%n";
1601    const char blankform[]= "%*[ \t]%n";    const char blankform[]= "%*[ \t]%n";
1602    const char ebrackform[]= "]%n";    const char ebrackform[]= "]%n";
1603    const char semicform[]= ";%n";    const char semicform[]= ";%n";
1604    const char bbrackform[]= "[%n";    const char bbrackform[]= "[%n";
1605    
1606    int itemp, readlength= -1;    int itemp, readlength= -1;
1607      int count= -1;
1608      float ftemp;
1609    static int depth= 0;    static int depth= 0;
1610    char *match;    char *match, *ctemp;
1611    size_t inlength;    size_t inlength;
1612    
1613    if(env->in_string==NULL) {    if(env->in_string==NULL) {
# Line 1383  extern void sx_72656164(environment *env Line 1616  extern void sx_72656164(environment *env
1616      }      }
1617      readline(env); if(env->err) return;      readline(env); if(env->err) return;
1618    
1619      if(((char *)(env->head->item->content.ptr))[0]=='\0'){      if(((char *)(CAR(env->head)->content.ptr))[0]=='\0'){
1620        env->err= 4;              /* "" means EOF */        env->err= 4;              /* "" means EOF */
1621        return;        return;
1622      }      }
1623            
1624      env->in_string= malloc(strlen(env->head->item->content.ptr)+1);      env->in_string= malloc(strlen(CAR(env->head)->content.ptr)+1);
1625      env->free_string= env->in_string; /* Save the original pointer */      env->free_string= env->in_string; /* Save the original pointer */
1626      strcpy(env->in_string, env->head->item->content.ptr);      strcpy(env->in_string, CAR(env->head)->content.ptr);
1627      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1628    }    }
1629        
1630    inlength= strlen(env->in_string)+1;    inlength= strlen(env->in_string)+1;
1631    match= malloc(inlength);    match= malloc(inlength);
1632    
1633    if(sscanf(env->in_string, blankform, &readlength)!=EOF    if(sscanf(env->in_string, blankform, &readlength) != EOF
1634       && readlength != -1) {       && readlength != -1) {
1635      ;      ;
1636    } else if(sscanf(env->in_string, intform, &itemp, &readlength) != EOF    } else if(sscanf(env->in_string, fltform, &ftemp, &readlength) != EOF
1637              && readlength != -1) {              && readlength != -1) {
1638      push_int(env, itemp);      if(sscanf(env->in_string, intform, &itemp, &count) != EOF
1639           && count==readlength) {
1640          push_int(env, itemp);
1641        } else {
1642          push_float(env, ftemp);
1643        }
1644    } else if(sscanf(env->in_string, strform, match, &readlength) != EOF    } else if(sscanf(env->in_string, strform, match, &readlength) != EOF
1645              && readlength != -1) {              && readlength != -1) {
1646      push_cstring(env, match);      push_cstring(env, match);
# Line 1424  extern void sx_72656164(environment *env Line 1662  extern void sx_72656164(environment *env
1662      free(env->free_string);      free(env->free_string);
1663      env->in_string = env->free_string = NULL;      env->in_string = env->free_string = NULL;
1664    }    }
1665    if ( env->in_string != NULL) {    if (env->in_string != NULL) {
1666      env->in_string += readlength;      env->in_string += readlength;
1667    }    }
1668    
# Line 1434  extern void sx_72656164(environment *env Line 1672  extern void sx_72656164(environment *env
1672      return sx_72656164(env);      return sx_72656164(env);
1673  }  }
1674    
1675  extern void beep(environment *env) {  extern void beep(environment *env)
1676    {
1677    int freq, dur, period, ticks;    int freq, dur, period, ticks;
1678    
1679    if((env->head)==NULL || env->head->next==NULL) {    if(env->head==NULL || CDR(env->head)==NULL) {
1680      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1681      env->err=1;      env->err= 1;
1682      return;      return;
1683    }    }
1684    
1685    if(env->head->item->type!=integer    if(CAR(env->head)->type!=integer
1686       || env->head->next->item->type!=integer) {       || CAR(CDR(env->head))->type!=integer) {
1687      printerr("Bad Argument Type");      printerr("Bad Argument Type");
1688      env->err=2;      env->err= 2;
1689      return;      return;
1690    }    }
1691    
1692    dur=env->head->item->content.val;    dur= CAR(env->head)->content.i;
1693    toss(env);    toss(env);
1694    freq=env->head->item->content.val;    freq= CAR(env->head)->content.i;
1695    toss(env);    toss(env);
1696    
1697    period=1193180/freq;          /* convert freq from Hz to period    period= 1193180/freq;         /* convert freq from Hz to period
1698                                     length */                                     length */
1699    ticks=dur*.001193180;         /* convert duration from µseconds to    ticks= dur*.001193180;        /* convert duration from µseconds to
1700                                     timer ticks */                                     timer ticks */
1701    
1702  /*    ticks=dur/1000; */  /*    ticks=dur/1000; */
1703    
1704    /*  if (ioctl(STDOUT_FILENO, KDMKTONE, (125<<16) + 0x637)==0) */        /*  if (ioctl(STDOUT_FILENO, KDMKTONE, (125<<16) + 0x637)==0) */
1705    switch (ioctl(STDOUT_FILENO, KDMKTONE, (ticks<<16) | period)){    switch (ioctl(STDOUT_FILENO, KDMKTONE, (ticks<<16) | period)){
1706    case 0:    case 0:
1707      usleep(dur);      usleep(dur);
1708      return;      return;
1709    case -1:    case -1:
1710      perror("beep");      perror("beep");
1711      env->err=5;      env->err= 5;
1712      return;      return;
1713    default:    default:
1714      abort();      abort();
1715    }    }
1716  };  }
1717    
1718  /* "wait" */  /* "wait" */
1719  extern void sx_77616974(environment *env) {  extern void sx_77616974(environment *env)
1720    {
1721    int dur;    int dur;
1722    
1723    if((env->head)==NULL) {    if(env->head==NULL) {
1724      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1725      env->err=1;      env->err= 1;
1726      return;      return;
1727    }    }
1728    
1729    if(env->head->item->type!=integer) {    if(CAR(env->head)->type!=integer) {
1730      printerr("Bad Argument Type");      printerr("Bad Argument Type");
1731      env->err=2;      env->err= 2;
1732      return;      return;
1733    }    }
1734    
1735    dur=env->head->item->content.val;    dur= CAR(env->head)->content.i;
1736    toss(env);    toss(env);
1737    
1738    usleep(dur);    usleep(dur);
1739  };  }
1740    
1741  extern void copying(environment *env){  extern void copying(environment *env)
1742    {
1743    printf("GNU GENERAL PUBLIC LICENSE\n\    printf("GNU GENERAL PUBLIC LICENSE\n\
1744                         Version 2, June 1991\n\                         Version 2, June 1991\n\
1745  \n\  \n\
# Line 1759  of preserving the free status of all der Line 1998  of preserving the free status of all der
1998  of promoting the sharing and reuse of software generally.\n");  of promoting the sharing and reuse of software generally.\n");
1999  }  }
2000    
2001  extern void warranty(environment *env){  extern void warranty(environment *env)
2002    {
2003    printf("                          NO WARRANTY\n\    printf("                          NO WARRANTY\n\
2004  \n\  \n\
2005    11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY\n\    11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY\n\
# Line 1787  POSSIBILITY OF SUCH DAMAGES.\n"); Line 2027  POSSIBILITY OF SUCH DAMAGES.\n");
2027  extern void sx_2a(environment *env)  extern void sx_2a(environment *env)
2028  {  {
2029    int a, b;    int a, b;
2030      float fa, fb;
2031    
2032    if((env->head)==NULL || env->head->next==NULL) {    if(env->head==NULL || CDR(env->head)==NULL) {
2033      printerr("Too Few Arguments");      printerr("Too Few Arguments");
2034      env->err=1;      env->err= 1;
2035      return;      return;
2036    }    }
2037        
2038    if(env->head->item->type!=integer    if(CAR(env->head)->type==integer
2039       || env->head->next->item->type!=integer) {       && CAR(CDR(env->head))->type==integer) {
2040      printerr("Bad Argument Type");      a= CAR(env->head)->content.i;
2041      env->err=2;      toss(env); if(env->err) return;
2042        b= CAR(env->head)->content.i;
2043        toss(env); if(env->err) return;
2044        push_int(env, b*a);
2045    
2046      return;      return;
2047    }    }
2048    
2049    a=env->head->item->content.val;    if(CAR(env->head)->type==tfloat
2050    toss(env); if(env->err) return;       && CAR(CDR(env->head))->type==tfloat) {
2051    b=env->head->item->content.val;      fa= CAR(env->head)->content.f;
2052    toss(env); if(env->err) return;      toss(env); if(env->err) return;
2053    push_int(env, b*a);      fb= CAR(env->head)->content.f;
2054        toss(env); if(env->err) return;
2055        push_float(env, fb*fa);
2056        
2057        return;
2058      }
2059    
2060      if(CAR(env->head)->type==tfloat
2061         && CAR(CDR(env->head))->type==integer) {
2062        fa= CAR(env->head)->content.f;
2063        toss(env); if(env->err) return;
2064        b= CAR(env->head)->content.i;
2065        toss(env); if(env->err) return;
2066        push_float(env, b*fa);
2067        
2068        return;
2069      }
2070    
2071      if(CAR(env->head)->type==integer
2072         && CAR(CDR(env->head))->type==tfloat) {
2073        a= CAR(env->head)->content.i;
2074        toss(env); if(env->err) return;
2075        fb= CAR(env->head)->content.f;
2076        toss(env); if(env->err) return;
2077        push_float(env, fb*a);
2078    
2079        return;
2080      }
2081    
2082      printerr("Bad Argument Type");
2083      env->err= 2;
2084  }  }
2085    
2086  /* "/" */  /* "/" */
2087  extern void sx_2f(environment *env)  extern void sx_2f(environment *env)
2088  {  {
2089    int a, b;    int a, b;
2090      float fa, fb;
2091    
2092    if((env->head)==NULL || env->head->next==NULL) {    if(env->head==NULL || CDR(env->head)==NULL) {
2093      printerr("Too Few Arguments");      printerr("Too Few Arguments");
2094      env->err=1;      env->err= 1;
2095      return;      return;
2096    }    }
2097        
2098    if(env->head->item->type!=integer    if(CAR(env->head)->type==integer
2099       || env->head->next->item->type!=integer) {       && CAR(CDR(env->head))->type==integer) {
2100      printerr("Bad Argument Type");      a= CAR(env->head)->content.i;
2101      env->err=2;      toss(env); if(env->err) return;
2102        b= CAR(env->head)->content.i;
2103        toss(env); if(env->err) return;
2104        push_float(env, b/a);
2105    
2106      return;      return;
2107    }    }
2108    
2109    a=env->head->item->content.val;    if(CAR(env->head)->type==tfloat
2110    toss(env); if(env->err) return;       && CAR(CDR(env->head))->type==tfloat) {
2111    b=env->head->item->content.val;      fa= CAR(env->head)->content.f;
2112    toss(env); if(env->err) return;      toss(env); if(env->err) return;
2113    push_int(env, b/a);      fb= CAR(env->head)->content.f;
2114        toss(env); if(env->err) return;
2115        push_float(env, fb/fa);
2116        
2117        return;
2118      }
2119    
2120      if(CAR(env->head)->type==tfloat
2121         && CAR(CDR(env->head))->type==integer) {
2122        fa= CAR(env->head)->content.f;
2123        toss(env); if(env->err) return;
2124        b= CAR(env->head)->content.i;
2125        toss(env); if(env->err) return;
2126        push_float(env, b/fa);
2127        
2128        return;
2129      }
2130    
2131      if(CAR(env->head)->type==integer
2132         && CAR(CDR(env->head))->type==tfloat) {
2133        a= CAR(env->head)->content.i;
2134        toss(env); if(env->err) return;
2135        fb= CAR(env->head)->content.f;
2136        toss(env); if(env->err) return;
2137        push_float(env, fb/a);
2138    
2139        return;
2140      }
2141    
2142      printerr("Bad Argument Type");
2143      env->err= 2;
2144  }  }
2145    
2146  /* "mod" */  /* "mod" */
# Line 1838  extern void mod(environment *env) Line 2148  extern void mod(environment *env)
2148  {  {
2149    int a, b;    int a, b;
2150    
2151    if((env->head)==NULL || env->head->next==NULL) {    if(env->head==NULL || CDR(env->head)==NULL) {
2152      printerr("Too Few Arguments");      printerr("Too Few Arguments");
2153      env->err=1;      env->err= 1;
2154      return;      return;
2155    }    }
2156        
2157    if(env->head->item->type!=integer    if(CAR(env->head)->type==integer
2158       || env->head->next->item->type!=integer) {       && CAR(CDR(env->head))->type==integer) {
2159      printerr("Bad Argument Type");      a= CAR(env->head)->content.i;
2160      env->err=2;      toss(env); if(env->err) return;
2161        b= CAR(env->head)->content.i;
2162        toss(env); if(env->err) return;
2163        push_int(env, b%a);
2164    
2165      return;      return;
2166    }    }
2167    
2168    a=env->head->item->content.val;    printerr("Bad Argument Type");
2169    toss(env); if(env->err) return;    env->err= 2;
2170    b=env->head->item->content.val;  }
2171    toss(env); if(env->err) return;  
2172    push_int(env, b%a);  /* "div" */
2173    extern void sx_646976(environment *env)
2174    {
2175      int a, b;
2176      
2177      if(env->head==NULL || CDR(env->head)==NULL) {
2178        printerr("Too Few Arguments");
2179        env->err= 1;
2180        return;
2181      }
2182    
2183      if(CAR(env->head)->type==integer
2184         && CAR(CDR(env->head))->type==integer) {
2185        a= CAR(env->head)->content.i;
2186        toss(env); if(env->err) return;
2187        b= CAR(env->head)->content.i;
2188        toss(env); if(env->err) return;
2189        push_int(env, (int)b/a);
2190    
2191        return;
2192      }
2193    
2194      printerr("Bad Argument Type");
2195      env->err= 2;
2196  }  }
Legend:
Removed from v.1.92  
changed lines
  Added in v.1.106
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26