/[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.98 by masse, Sun Mar 10 09:13:36 2002 UTC
# Line 48  void init_env(environment *env) Line 48  void init_env(environment *env)
48  {  {
49    int i;    int i;
50    
51    env->gc_limit= 20;    env->gc_limit= 200;
52    env->gc_count= 0;    env->gc_count= 0;
53    env->gc_ref= NULL;    env->gc_ref= NULL;
   env->gc_protect= NULL;  
54    
55    env->head= NULL;    env->head= NULL;
56    for(i= 0; i<HASHTBLSIZE; i++)    for(i= 0; i<HASHTBLSIZE; i++)
# Line 63  void init_env(environment *env) Line 62  void init_env(environment *env)
62    env->interactive= 1;    env->interactive= 1;
63  }  }
64    
65  void printerr(const char* in_string) {  void printerr(const char* in_string)
66    {
67    fprintf(stderr, "Err: %s\n", in_string);    fprintf(stderr, "Err: %s\n", in_string);
68  }  }
69    
# Line 81  extern void toss(environment *env) Line 81  extern void toss(environment *env)
81    env->head= env->head->next;   /* Remove the top stack item */    env->head= env->head->next;   /* Remove the top stack item */
82    free(temp);                   /* Free the old top stack item */    free(temp);                   /* Free the old top stack item */
83    
84    gc_init(env);    env->gc_limit--;
85  }  }
86    
87  /* 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 113  symbol **hash(hashtbl in_hashtbl, const
113    }    }
114  }  }
115    
116  value* new_val(environment *env) {  /* Create new value */
117    value* new_val(environment *env)
118    {
119    value *nval= malloc(sizeof(value));    value *nval= malloc(sizeof(value));
120    stackitem *nitem= malloc(sizeof(stackitem));    stackitem *nitem= malloc(sizeof(stackitem));
121    
122    nval->content.ptr= NULL;    nval->content.ptr= NULL;
   protect(env, nval);  
   
   gc_init(env);  
123    
124    nitem->item= nval;    nitem->item= nval;
125    nitem->next= env->gc_ref;    nitem->next= env->gc_ref;
126    env->gc_ref= nitem;    env->gc_ref= nitem;
127    
128    env->gc_count++;    env->gc_count++;
129    unprotect(env);    nval->gc_garb= 1;
130    
131    return nval;    return nval;
132  }  }
133    
134  void gc_mark(value *val) {  /* Mark values recursively.
135       Marked values are not collected by the GC. */
136    inline void gc_mark(value *val)
137    {
138    stackitem *iterator;    stackitem *iterator;
139    
140    if(val==NULL || val->gc_garb==0)    if(val->gc_garb==0)
141      return;      return;
142    
143    val->gc_garb= 0;    val->gc_garb= 0;
# Line 150  void gc_mark(value *val) { Line 152  void gc_mark(value *val) {
152    }    }
153  }  }
154    
155  extern void gc_init(environment *env) {  inline void gc_maybe(environment *env)
156    stackitem *new_head= NULL, *titem, *iterator= env->gc_ref;  {
   symbol *tsymb;  
   int i;  
   
157    if(env->gc_count < env->gc_limit)    if(env->gc_count < env->gc_limit)
158      return;      return;
159      else
160        return gc_init(env);
161    }
162    
163    while(iterator!=NULL) {  /* Start GC */
164      iterator->item->gc_garb= 1;  extern void gc_init(environment *env)
165      iterator= iterator->next;  {
166    }    stackitem *new_head= NULL, *titem, *iterator;
167      symbol *tsymb;
168    /* Mark */    int i;
   iterator= env->gc_protect;  
   while(iterator!=NULL) {  
     gc_mark(iterator->item);  
     iterator= iterator->next;  
   }  
169    
170      /* Mark values on stack */
171    iterator= env->head;    iterator= env->head;
172    while(iterator!=NULL) {    while(iterator!=NULL) {
173      gc_mark(iterator->item);      gc_mark(iterator->item);
174      iterator= iterator->next;      iterator= iterator->next;
175    }    }
176    
177      /* Mark values in hashtable */
178    for(i= 0; i<HASHTBLSIZE; i++) {    for(i= 0; i<HASHTBLSIZE; i++) {
179      tsymb= env->symbols[i];      tsymb= env->symbols[i];
180      while(tsymb!=NULL) {      while(tsymb!=NULL) {
181        gc_mark(tsymb->val);        if (tsymb->val != NULL)
182            gc_mark(tsymb->val);
183        tsymb= tsymb->next;        tsymb= tsymb->next;
184      }      }
185    }    }
186    
187    env->gc_count= 0;    env->gc_count= 0;
188    
189    /* Sweep */    while(env->gc_ref!=NULL) {    /* Sweep unused values */
   while(env->gc_ref!=NULL) {  
190    
191      if(env->gc_ref->item->gc_garb) {      if(env->gc_ref->item->gc_garb
192        switch(env->gc_ref->item->type) {         && !(env->gc_ref->item->gc_protect)) {
193    
194          switch(env->gc_ref->item->type) { /* Remove content */
195        case string:        case string:
196          free(env->gc_ref->item->content.ptr);          free(env->gc_ref->item->content.ptr);
197          break;          break;
       case integer:  
         break;  
198        case list:        case list:
199          while(env->gc_ref->item->content.ptr!=NULL) {          while(env->gc_ref->item->content.ptr!=NULL) {
200            titem= env->gc_ref->item->content.ptr;            titem= env->gc_ref->item->content.ptr;
201            env->gc_ref->item->content.ptr= titem->next;            env->gc_ref->item->content.ptr= titem->next;
202            free(titem);            free(titem);
203          }          }
         break;  
204        default:        default:
         break;  
205        }        }
206        free(env->gc_ref->item);        free(env->gc_ref->item);  /* Remove from gc_ref */
207        titem= env->gc_ref->next;        titem= env->gc_ref->next;
208        free(env->gc_ref);        free(env->gc_ref);        /* Remove value */
209        env->gc_ref= titem;        env->gc_ref= titem;
210      } else {        continue;
       titem= env->gc_ref->next;  
       env->gc_ref->next= new_head;  
       new_head= env->gc_ref;  
       env->gc_ref= titem;  
       env->gc_count++;  
211      }      }
212        
213        /* Keep values */
214        titem= env->gc_ref->next;
215        env->gc_ref->next= new_head;
216        new_head= env->gc_ref;
217        new_head->item->gc_garb= 1;
218        env->gc_ref= titem;
219        env->gc_count++;
220    }    }
221    
222    env->gc_limit= env->gc_count*2;    env->gc_limit= env->gc_count*2;
223    env->gc_ref= new_head;    env->gc_ref= new_head;
224  }  }
225    
226  void protect(environment *env, value *val)  /* Protect values from GC */
227    void protect(value *val)
228  {  {
229    stackitem *new_item= malloc(sizeof(stackitem));    stackitem *iterator;
230    new_item->item= val;  
231    new_item->next= env->gc_protect;    if(val->gc_protect)
232    env->gc_protect= new_item;      return;
233    
234      val->gc_protect= 1;
235    
236      if(val->type==list) {
237        iterator= val->content.ptr;
238    
239        while(iterator!=NULL) {
240          protect(iterator->item);
241          iterator= iterator->next;
242        }
243      }
244  }  }
245    
246  void unprotect(environment *env)  /* Unprotect values from GC */
247    void unprotect(value *val)
248  {  {
249    stackitem *temp= env->gc_protect;    stackitem *iterator;
250    env->gc_protect= env->gc_protect->next;  
251    free(temp);    if(!(val->gc_protect))
252        return;
253    
254      val->gc_protect= 0;
255    
256      if(val->type==list) {
257        iterator= val->content.ptr;
258    
259        while(iterator!=NULL) {
260          unprotect(iterator->item);
261          iterator= iterator->next;
262        }
263      }
264  }  }
265    
266  /* Push a value onto the stack */  /* Push a value onto the stack */
# Line 247  void push_val(environment *env, value *v Line 272  void push_val(environment *env, value *v
272    env->head= new_item;    env->head= new_item;
273  }  }
274    
275  /* Push an integer onto the stack. */  /* Push an integer onto the stack */
276  void push_int(environment *env, int in_val)  void push_int(environment *env, int in_val)
277  {  {
278    value *new_value= new_val(env);    value *new_value= new_val(env);
279        
280    new_value->content.val= in_val;    new_value->content.i= in_val;
281    new_value->type= integer;    new_value->type= integer;
282    
283    push_val(env, new_value);    push_val(env, new_value);
284  }  }
285    
286    /* Push a floating point number onto the stack */
287    void push_float(environment *env, float in_val)
288    {
289      value *new_value= new_val(env);
290    
291      new_value->content.f= in_val;
292      new_value->type= tfloat;
293    
294      push_val(env, new_value);
295    }
296    
297  /* Copy a string onto the stack. */  /* Copy a string onto the stack. */
298  void push_cstring(environment *env, const char *in_string)  void push_cstring(environment *env, const char *in_string)
299  {  {
# Line 271  void push_cstring(environment *env, cons Line 307  void push_cstring(environment *env, cons
307  }  }
308    
309  /* Mangle a symbol name to a valid C identifier name */  /* Mangle a symbol name to a valid C identifier name */
310  char *mangle_str(const char *old_string){  char *mangle_str(const char *old_string)
311    {
312    char validchars[]= "0123456789abcdef";    char validchars[]= "0123456789abcdef";
313    char *new_string, *current;    char *new_string, *current;
314    
# Line 289  char *mangle_str(const char *old_string) Line 326  char *mangle_str(const char *old_string)
326    return new_string;            /* The caller must free() it */    return new_string;            /* The caller must free() it */
327  }  }
328    
329  extern void mangle(environment *env){  extern void mangle(environment *env)
330    {
331    char *new_string;    char *new_string;
332    
333    if((env->head)==NULL) {    if((env->head)==NULL) {
# Line 328  void push_sym(environment *env, const ch Line 366  void push_sym(environment *env, const ch
366    char *mangled;                /* Mangled function name */    char *mangled;                /* Mangled function name */
367    
368    new_value= new_val(env);    new_value= new_val(env);
369      protect(new_value);
370      new_fvalue= new_val(env);
371      protect(new_fvalue);
372    
373    /* The new value is a symbol */    /* The new value is a symbol */
374    new_value->type= symb;    new_value->type= symb;
# Line 355  void push_sym(environment *env, const ch Line 396  void push_sym(environment *env, const ch
396    
397      mangled= mangle_str(in_string); /* mangle the name */      mangled= mangle_str(in_string); /* mangle the name */
398      funcptr= dlsym(handle, mangled); /* and try to find it */      funcptr= dlsym(handle, mangled); /* and try to find it */
399      free(mangled);  
400      dlerr= dlerror();      dlerr= dlerror();
401      if(dlerr != NULL) {         /* If no function was found */      if(dlerr != NULL) {         /* If no function was found */
402        funcptr= dlsym(handle, in_string); /* Get function pointer */        funcptr= dlsym(handle, in_string); /* Get function pointer */
403        dlerr= dlerror();        dlerr= dlerror();
404      }      }
405    
406      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 */  
407        new_fvalue->type= func;   /* The new value is a function pointer */        new_fvalue->type= func;   /* The new value is a function pointer */
408        new_fvalue->content.ptr= funcptr; /* Store function pointer */        new_fvalue->content.ptr= funcptr; /* Store function pointer */
409        (*new_symbol)->val= new_fvalue; /* Bind the symbol to the new        (*new_symbol)->val= new_fvalue; /* Bind the symbol to the new
410                                           function value */                                           function value */
411      }      }
412    
413        free(mangled);
414    }    }
415    
416    push_val(env, new_value);    push_val(env, new_value);
417      unprotect(new_value); unprotect(new_fvalue);
418  }  }
419    
420  /* Print newline. */  /* Print newline. */
# Line 379  extern void nl() Line 424  extern void nl()
424  }  }
425    
426  /* Gets the type of a value */  /* Gets the type of a value */
427  extern void type(environment *env){  extern void type(environment *env)
428    {
429    int typenum;    int typenum;
430    
431    if((env->head)==NULL) {    if((env->head)==NULL) {
# Line 393  extern void type(environment *env){ Line 439  extern void type(environment *env){
439    case integer:    case integer:
440      push_sym(env, "integer");      push_sym(env, "integer");
441      break;      break;
442      case tfloat:
443        push_sym(env, "float");
444        break;
445    case string:    case string:
446      push_sym(env, "string");      push_sym(env, "string");
447      break;      break;
# Line 413  void print_h(stackitem *stack_head, int Line 462  void print_h(stackitem *stack_head, int
462  {  {
463    switch(stack_head->item->type) {    switch(stack_head->item->type) {
464    case integer:    case integer:
465      printf("%d", stack_head->item->content.val);      printf("%d", stack_head->item->content.i);
466        break;
467      case tfloat:
468        printf("%f", stack_head->item->content.f);
469      break;      break;
470    case string:    case string:
471      if(noquote)      if(noquote)
# Line 441  void print_h(stackitem *stack_head, int Line 493  void print_h(stackitem *stack_head, int
493    }    }
494  }  }
495    
496  extern void print_(environment *env) {  extern void print_(environment *env)
497    {
498    if(env->head==NULL) {    if(env->head==NULL) {
499      printerr("Too Few Arguments");      printerr("Too Few Arguments");
500      env->err=1;      env->err=1;
# Line 459  extern void print(environment *env) Line 512  extern void print(environment *env)
512    toss(env);    toss(env);
513  }  }
514    
515  extern void princ_(environment *env) {  extern void princ_(environment *env)
516    {
517    if(env->head==NULL) {    if(env->head==NULL) {
518      printerr("Too Few Arguments");      printerr("Too Few Arguments");
519      env->err=1;      env->err=1;
# Line 493  extern void printstack(environment *env) Line 547  extern void printstack(environment *env)
547      printf("Stack Empty\n");      printf("Stack Empty\n");
548      return;      return;
549    }    }
550    
551    print_st(env->head, 1);    print_st(env->head, 1);
552  }  }
553    
# Line 552  extern void rcl(environment *env) Line 607  extern void rcl(environment *env)
607      env->err=3;      env->err=3;
608      return;      return;
609    }    }
610    protect(env, val);    protect(val);
611    toss(env);            /* toss the symbol */    toss(env);            /* toss the symbol */
612    if(env->err) return;    if(env->err) return;
613    push_val(env, val); /* Return its bound value */    push_val(env, val); /* Return its bound value */
614    unprotect(env);    unprotect(val);
615  }  }
616    
617  /* 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 570  extern void eval(environment *env) Line 625  extern void eval(environment *env)
625    
626   eval_start:   eval_start:
627    
628      gc_maybe(env);
629    
630    if(env->head==NULL) {    if(env->head==NULL) {
631      printerr("Too Few Arguments");      printerr("Too Few Arguments");
632      env->err=1;      env->err=1;
# Line 596  extern void eval(environment *env) Line 653  extern void eval(environment *env)
653      /* If it's a list */      /* If it's a list */
654    case list:    case list:
655      temp_val= env->head->item;      temp_val= env->head->item;
656      protect(env, temp_val);      protect(temp_val);
657      toss(env);  
658      if(env->err) return;      toss(env); if(env->err) return;
659      iterator= (stackitem*)temp_val->content.ptr;      iterator= (stackitem*)temp_val->content.ptr;
     unprotect(env);  
660            
661      while(iterator!=NULL) {      while(iterator!=NULL) {
662        push_val(env, iterator->item);        push_val(env, iterator->item);
# Line 618  extern void eval(environment *env) Line 674  extern void eval(environment *env)
674        }        }
675        iterator= iterator->next;        iterator= iterator->next;
676      }      }
677        unprotect(temp_val);
678      return;      return;
679    
680    default:    default:
# Line 626  extern void eval(environment *env) Line 683  extern void eval(environment *env)
683  }  }
684    
685  /* Reverse (flip) a list */  /* Reverse (flip) a list */
686  extern void rev(environment *env){  extern void rev(environment *env)
687    {
688    stackitem *old_head, *new_head, *item;    stackitem *old_head, *new_head, *item;
689    
690    if((env->head)==NULL) {    if((env->head)==NULL) {
# Line 659  extern void pack(environment *env) Line 717  extern void pack(environment *env)
717    value *pack;    value *pack;
718    
719    iterator= env->head;    iterator= env->head;
720      pack= new_val(env);
721      protect(pack);
722    
723    if(iterator==NULL    if(iterator==NULL
724       || (iterator->item->type==symb       || (iterator->item->type==symb
# Line 676  extern void pack(environment *env) Line 736  extern void pack(environment *env)
736      temp= env->head;      temp= env->head;
737      env->head= iterator->next;      env->head= iterator->next;
738      iterator->next= NULL;      iterator->next= NULL;
739    
740        pack->type= list;
741        pack->content.ptr= temp;
742            
743      if(env->head!=NULL)      if(env->head!=NULL)
744        toss(env);        toss(env);
745    }    }
746    
747    /* Push list */    /* Push list */
   pack= new_val(env);  
   pack->type= list;  
   pack->content.ptr= temp;  
748    
749    push_val(env, pack);    push_val(env, pack);
750    rev(env);    rev(env);
751    
752      unprotect(pack);
753  }  }
754    
755  /* Relocate elements of the list on the stack. */  /* Relocate elements of the list on the stack. */
# Line 765  extern void not(environment *env) Line 827  extern void not(environment *env)
827      return;      return;
828    }    }
829    
830    val= env->head->item->content.val;    val= env->head->item->content.i;
831    toss(env);    toss(env);
832    push_int(env, !val);    push_int(env, !val);
833  }  }
# Line 808  extern void def(environment *env) Line 870  extern void def(environment *env)
870  /* Quit stack. */  /* Quit stack. */
871  extern void quit(environment *env)  extern void quit(environment *env)
872  {  {
873    long i;    int i;
874    
875    clear(env);    clear(env);
876    
# Line 821  extern void quit(environment *env) Line 883  extern void quit(environment *env)
883    }    }
884    
885    env->gc_limit= 0;    env->gc_limit= 0;
886    gc_init(env);    gc_maybe(env);
887    
888    if(env->free_string!=NULL)    if(env->free_string!=NULL)
889      free(env->free_string);      free(env->free_string);
# Line 854  extern void words(environment *env) Line 916  extern void words(environment *env)
916  }  }
917    
918  /* Internal forget function */  /* Internal forget function */
919  void forget_sym(symbol **hash_entry) {  void forget_sym(symbol **hash_entry)
920    {
921    symbol *temp;    symbol *temp;
922    
923    temp= *hash_entry;    temp= *hash_entry;
# Line 889  extern void forget(environment *env) Line 952  extern void forget(environment *env)
952  }  }
953    
954  /* Returns the current error number to the stack */  /* Returns the current error number to the stack */
955  extern void errn(environment *env){  extern void errn(environment *env)
956    {
957    push_int(env, env->err);    push_int(env, env->err);
958  }  }
959    
# Line 958  under certain conditions; type `copying; Line 1022  under certain conditions; type `copying;
1022        toss(&myenv);             /* No error check in main */        toss(&myenv);             /* No error check in main */
1023        eval(&myenv);        eval(&myenv);
1024      }      }
1025      gc_init(&myenv);      gc_maybe(&myenv);
1026    }    }
1027    quit(&myenv);    quit(&myenv);
1028    return EXIT_FAILURE;    return EXIT_FAILURE;
1029  }  }
1030    
1031  /* "+" */  /* "+" */
1032  extern void sx_2b(environment *env) {  extern void sx_2b(environment *env)
1033    {
1034    int a, b;    int a, b;
1035      float fa, fb;
1036    size_t len;    size_t len;
1037    char* new_string;    char* new_string;
1038    value *a_val, *b_val;    value *a_val, *b_val;
# Line 981  extern void sx_2b(environment *env) { Line 1047  extern void sx_2b(environment *env) {
1047       && env->head->next->item->type==string) {       && env->head->next->item->type==string) {
1048      a_val= env->head->item;      a_val= env->head->item;
1049      b_val= env->head->next->item;      b_val= env->head->next->item;
1050      protect(env, a_val); protect(env, b_val);      protect(a_val); protect(b_val);
1051      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1052      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1053      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 1055  extern void sx_2b(environment *env) {
1055      strcpy(new_string, b_val->content.ptr);      strcpy(new_string, b_val->content.ptr);
1056      strcat(new_string, a_val->content.ptr);      strcat(new_string, a_val->content.ptr);
1057      push_cstring(env, new_string);      push_cstring(env, new_string);
1058      unprotect(env); unprotect(env);      unprotect(a_val); unprotect(b_val);
1059      free(new_string);      free(new_string);
1060        
1061      return;      return;
1062    }    }
1063        
1064    if(env->head->item->type!=integer    if(env->head->item->type==integer
1065       || env->head->next->item->type!=integer) {       && env->head->next->item->type==integer) {
1066      printerr("Bad Argument Type");      a=env->head->item->content.i;
1067      env->err=2;      toss(env); if(env->err) return;
1068        b=env->head->item->content.i;
1069        toss(env); if(env->err) return;
1070        push_int(env, b+a);
1071    
1072      return;      return;
1073    }    }
1074    a= env->head->item->content.val;  
1075    toss(env); if(env->err) return;    if(env->head->item->type==tfloat
1076           && env->head->next->item->type==tfloat) {
1077    b= env->head->item->content.val;      fa= env->head->item->content.f;
1078    toss(env); if(env->err) return;      toss(env); if(env->err) return;
1079    push_int(env, a+b);      fb= env->head->item->content.f;
1080        toss(env); if(env->err) return;
1081        push_float(env, fb+fa);
1082        
1083        return;
1084      }
1085    
1086      if(env->head->item->type==tfloat
1087         && env->head->next->item->type==integer) {
1088        fa= env->head->item->content.f;
1089        toss(env); if(env->err) return;
1090        b= env->head->item->content.i;
1091        toss(env); if(env->err) return;
1092        push_float(env, b+fa);
1093        
1094        return;
1095      }
1096    
1097      if(env->head->item->type==integer
1098         && env->head->next->item->type==tfloat) {
1099        a= env->head->item->content.i;
1100        toss(env); if(env->err) return;
1101        fb= env->head->item->content.f;
1102        toss(env); if(env->err) return;
1103        push_float(env, fb+a);
1104    
1105        return;
1106      }
1107    
1108      printerr("Bad Argument Type");
1109      env->err=2;
1110  }  }
1111    
1112  /* "-" */  /* "-" */
1113  extern void sx_2d(environment *env) {  extern void sx_2d(environment *env)
1114    {
1115    int a, b;    int a, b;
1116      float fa, fb;
1117    
1118    if((env->head)==NULL || env->head->next==NULL) {    if((env->head)==NULL || env->head->next==NULL) {
1119      printerr("Too Few Arguments");      printerr("Too Few Arguments");
# Line 1018  extern void sx_2d(environment *env) { Line 1121  extern void sx_2d(environment *env) {
1121      return;      return;
1122    }    }
1123        
1124    if(env->head->item->type!=integer    if(env->head->item->type==integer
1125       || env->head->next->item->type!=integer) {       && env->head->next->item->type==integer) {
1126      printerr("Bad Argument Type");      a=env->head->item->content.i;
1127      env->err=2;      toss(env); if(env->err) return;
1128        b=env->head->item->content.i;
1129        toss(env); if(env->err) return;
1130        push_int(env, b-a);
1131    
1132      return;      return;
1133    }    }
1134    
1135    a=env->head->item->content.val;    if(env->head->item->type==tfloat
1136    toss(env); if(env->err) return;       && env->head->next->item->type==tfloat) {
1137    b=env->head->item->content.val;      fa= env->head->item->content.f;
1138    toss(env); if(env->err) return;      toss(env); if(env->err) return;
1139    push_int(env, b-a);      fb= env->head->item->content.f;
1140        toss(env); if(env->err) return;
1141        push_float(env, fb-fa);
1142        
1143        return;
1144      }
1145    
1146      if(env->head->item->type==tfloat
1147         && env->head->next->item->type==integer) {
1148        fa= env->head->item->content.f;
1149        toss(env); if(env->err) return;
1150        b= env->head->item->content.i;
1151        toss(env); if(env->err) return;
1152        push_float(env, b-fa);
1153        
1154        return;
1155      }
1156    
1157      if(env->head->item->type==integer
1158         && env->head->next->item->type==tfloat) {
1159        a= env->head->item->content.i;
1160        toss(env); if(env->err) return;
1161        fb= env->head->item->content.f;
1162        toss(env); if(env->err) return;
1163        push_float(env, fb-a);
1164    
1165        return;
1166      }
1167    
1168      printerr("Bad Argument Type");
1169      env->err=2;
1170  }  }
1171    
1172  /* ">" */  /* ">" */
1173  extern void sx_3e(environment *env) {  extern void sx_3e(environment *env)
1174    {
1175    int a, b;    int a, b;
1176      float fa, fb;
1177    
1178    if((env->head)==NULL || env->head->next==NULL) {    if((env->head)==NULL || env->head->next==NULL) {
1179      printerr("Too Few Arguments");      printerr("Too Few Arguments");
# Line 1042  extern void sx_3e(environment *env) { Line 1181  extern void sx_3e(environment *env) {
1181      return;      return;
1182    }    }
1183        
1184    if(env->head->item->type!=integer    if(env->head->item->type==integer
1185       || env->head->next->item->type!=integer) {       && env->head->next->item->type==integer) {
1186      printerr("Bad Argument Type");      a=env->head->item->content.i;
1187      env->err=2;      toss(env); if(env->err) return;
1188        b=env->head->item->content.i;
1189        toss(env); if(env->err) return;
1190        push_int(env, b>a);
1191    
1192      return;      return;
1193    }    }
1194    
1195    a=env->head->item->content.val;    if(env->head->item->type==tfloat
1196    toss(env); if(env->err) return;       && env->head->next->item->type==tfloat) {
1197    b=env->head->item->content.val;      fa= env->head->item->content.f;
1198    toss(env); if(env->err) return;      toss(env); if(env->err) return;
1199    push_int(env, b>a);      fb= env->head->item->content.f;
1200        toss(env); if(env->err) return;
1201        push_int(env, fb>fa);
1202        
1203        return;
1204      }
1205    
1206      if(env->head->item->type==tfloat
1207         && env->head->next->item->type==integer) {
1208        fa= env->head->item->content.f;
1209        toss(env); if(env->err) return;
1210        b= env->head->item->content.i;
1211        toss(env); if(env->err) return;
1212        push_int(env, b>fa);
1213        
1214        return;
1215      }
1216    
1217      if(env->head->item->type==integer
1218         && env->head->next->item->type==tfloat) {
1219        a= env->head->item->content.i;
1220        toss(env); if(env->err) return;
1221        fb= env->head->item->content.f;
1222        toss(env); if(env->err) return;
1223        push_int(env, fb>a);
1224    
1225        return;
1226      }
1227    
1228      printerr("Bad Argument Type");
1229      env->err=2;
1230    }
1231    
1232    /* "<" */
1233    extern void sx_3c(environment *env)
1234    {
1235      swap(env); if(env->err) return;
1236      sx_3e(env);
1237    }
1238    
1239    /* "<=" */
1240    extern void sx_3c3d(environment *env)
1241    {
1242      sx_3e(env); if(env->err) return;
1243      not(env);
1244    }
1245    
1246    /* ">=" */
1247    extern void sx_3e3d(environment *env)
1248    {
1249      sx_3c(env); if(env->err) return;
1250      not(env);
1251  }  }
1252    
1253  /* Return copy of a value */  /* Return copy of a value */
1254  value *copy_val(environment *env, value *old_value){  value *copy_val(environment *env, value *old_value)
1255    {
1256    stackitem *old_item, *new_item, *prev_item;    stackitem *old_item, *new_item, *prev_item;
1257      value *new_value;
1258    
1259    value *new_value= new_val(env);    protect(old_value);
1260      new_value= new_val(env);
1261    protect(env, old_value);    protect(new_value);
1262    new_value->type= old_value->type;    new_value->type= old_value->type;
1263    
1264    switch(old_value->type){    switch(old_value->type){
1265      case tfloat:
1266    case integer:    case integer:
1267      new_value->content.val= old_value->content.val;    case func:
1268      case symb:
1269        new_value->content= old_value->content;
1270      break;      break;
1271    case string:    case string:
1272      (char *)(new_value->content.ptr)=      (char *)(new_value->content.ptr)=
1273        strdup((char *)(old_value->content.ptr));        strdup((char *)(old_value->content.ptr));
1274      break;      break;
   case func:  
   case symb:  
     new_value->content.ptr= old_value->content.ptr;  
     break;  
1275    case list:    case list:
1276      new_value->content.ptr= NULL;      new_value->content.ptr= NULL;
1277    
# Line 1098  value *copy_val(environment *env, value Line 1293  value *copy_val(environment *env, value
1293      break;      break;
1294    }    }
1295    
1296    unprotect(env);    unprotect(old_value); unprotect(new_value);
1297    
1298    return new_value;    return new_value;
1299  }  }
1300    
1301  /* "dup"; duplicates an item on the stack */  /* "dup"; duplicates an item on the stack */
1302  extern void sx_647570(environment *env) {  extern void sx_647570(environment *env)
1303    {
1304    if((env->head)==NULL) {    if((env->head)==NULL) {
1305      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1306      env->err= 1;      env->err= 1;
# Line 1114  extern void sx_647570(environment *env) Line 1310  extern void sx_647570(environment *env)
1310  }  }
1311    
1312  /* "if", If-Then */  /* "if", If-Then */
1313  extern void sx_6966(environment *env) {  extern void sx_6966(environment *env)
1314    {
1315    int truth;    int truth;
1316    
1317    if((env->head)==NULL || env->head->next==NULL) {    if((env->head)==NULL || env->head->next==NULL) {
# Line 1133  extern void sx_6966(environment *env) { Line 1329  extern void sx_6966(environment *env) {
1329    swap(env);    swap(env);
1330    if(env->err) return;    if(env->err) return;
1331        
1332    truth=env->head->item->content.val;    truth=env->head->item->content.i;
1333    
1334    toss(env);    toss(env);
1335    if(env->err) return;    if(env->err) return;
# Line 1145  extern void sx_6966(environment *env) { Line 1341  extern void sx_6966(environment *env) {
1341  }  }
1342    
1343  /* If-Then-Else */  /* If-Then-Else */
1344  extern void ifelse(environment *env) {  extern void ifelse(environment *env)
1345    {
1346    int truth;    int truth;
1347    
1348    if((env->head)==NULL || env->head->next==NULL    if((env->head)==NULL || env->head->next==NULL
# Line 1165  extern void ifelse(environment *env) { Line 1361  extern void ifelse(environment *env) {
1361    rot(env);    rot(env);
1362    if(env->err) return;    if(env->err) return;
1363        
1364    truth=env->head->item->content.val;    truth=env->head->item->content.i;
1365    
1366    toss(env);    toss(env);
1367    if(env->err) return;    if(env->err) return;
# Line 1181  extern void ifelse(environment *env) { Line 1377  extern void ifelse(environment *env) {
1377  }  }
1378    
1379  /* "while" */  /* "while" */
1380  extern void sx_7768696c65(environment *env) {  extern void sx_7768696c65(environment *env)
1381    {
1382    int truth;    int truth;
1383    value *loop, *test;    value *loop, *test;
1384    
# Line 1193  extern void sx_7768696c65(environment *e Line 1389  extern void sx_7768696c65(environment *e
1389    }    }
1390    
1391    loop= env->head->item;    loop= env->head->item;
1392    protect(env, loop);    protect(loop);
1393    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1394    
1395    test= env->head->item;    test= env->head->item;
1396    protect(env, test);    protect(test);
1397    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1398    
1399    do {    do {
# Line 1210  extern void sx_7768696c65(environment *e Line 1406  extern void sx_7768696c65(environment *e
1406        return;        return;
1407      }      }
1408            
1409      truth= env->head->item->content.val;      truth= env->head->item->content.i;
1410      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1411            
1412      if(truth) {      if(truth) {
# Line 1222  extern void sx_7768696c65(environment *e Line 1418  extern void sx_7768696c65(environment *e
1418        
1419    } while(truth);    } while(truth);
1420    
1421    unprotect(env); unprotect(env);    unprotect(loop); unprotect(test);
1422  }  }
1423    
1424    
1425  /* "for"; for-loop */  /* "for"; for-loop */
1426  extern void sx_666f72(environment *env) {  extern void sx_666f72(environment *env)
1427    {
1428    value *loop;    value *loop;
1429    int foo1, foo2;    int foo1, foo2;
1430    
# Line 1246  extern void sx_666f72(environment *env) Line 1443  extern void sx_666f72(environment *env)
1443    }    }
1444    
1445    loop= env->head->item;    loop= env->head->item;
1446    protect(env, loop);    protect(loop);
1447    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1448    
1449    foo2= env->head->item->content.val;    foo2= env->head->item->content.i;
1450    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1451    
1452    foo1= env->head->item->content.val;    foo1= env->head->item->content.i;
1453    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1454    
1455    if(foo1<=foo2) {    if(foo1<=foo2) {
# Line 1270  extern void sx_666f72(environment *env) Line 1467  extern void sx_666f72(environment *env)
1467        foo1--;        foo1--;
1468      }      }
1469    }    }
1470    unprotect(env);    unprotect(loop);
1471  }  }
1472    
1473  /* Variant of for-loop */  /* Variant of for-loop */
1474  extern void foreach(environment *env) {  extern void foreach(environment *env)
1475      {  
1476    value *loop, *foo;    value *loop, *foo;
1477    stackitem *iterator;    stackitem *iterator;
1478        
# Line 1292  extern void foreach(environment *env) { Line 1489  extern void foreach(environment *env) {
1489    }    }
1490    
1491    loop= env->head->item;    loop= env->head->item;
1492    protect(env, loop);    protect(loop);
1493    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1494    
1495    foo= env->head->item;    foo= env->head->item;
1496    protect(env, foo);    protect(foo);
1497    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1498    
1499    iterator= foo->content.ptr;    iterator= foo->content.ptr;
# Line 1307  extern void foreach(environment *env) { Line 1504  extern void foreach(environment *env) {
1504      eval(env); if(env->err) return;      eval(env); if(env->err) return;
1505      iterator= iterator->next;      iterator= iterator->next;
1506    }    }
1507    unprotect(env); unprotect(env);    unprotect(loop); unprotect(foo);
1508  }  }
1509    
1510  /* "to" */  /* "to" */
1511  extern void to(environment *env) {  extern void to(environment *env)
1512    int i, start, ending;  {
1513    stackitem *temp_head;    int ending, start, i;
1514    value *temp_val;    stackitem *iterator, *temp;
1515        value *pack;
1516    
1517    if((env->head)==NULL || env->head->next==NULL) {    if((env->head)==NULL || env->head->next==NULL) {
1518      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1519      env->err=1;      env->err=1;
# Line 1329  extern void to(environment *env) { Line 1527  extern void to(environment *env) {
1527      return;      return;
1528    }    }
1529    
1530    ending= env->head->item->content.val;    ending= env->head->item->content.i;
1531    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1532    start= env->head->item->content.val;    start= env->head->item->content.i;
1533    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1534    
1535    temp_head= env->head;    push_sym(env, "[");
   env->head= NULL;  
1536    
1537    if(ending>=start) {    if(ending>=start) {
1538      for(i= ending; i>=start; i--)      for(i= ending; i>=start; i--)
# Line 1345  extern void to(environment *env) { Line 1542  extern void to(environment *env) {
1542        push_int(env, i);        push_int(env, i);
1543    }    }
1544    
1545    temp_val= new_val(env);    iterator= env->head;
1546    temp_val->content.ptr= env->head;    pack= new_val(env);
1547    temp_val->type= list;    protect(pack);
1548    env->head= temp_head;  
1549    push_val(env, temp_val);    if(iterator==NULL
1550         || (iterator->item->type==symb
1551         && ((symbol*)(iterator->item->content.ptr))->id[0]=='[')) {
1552        temp= NULL;
1553        toss(env);
1554      } else {
1555        /* Search for first delimiter */
1556        while(iterator->next!=NULL
1557              && (iterator->next->item->type!=symb
1558              || ((symbol*)(iterator->next->item->content.ptr))->id[0]!='['))
1559          iterator= iterator->next;
1560        
1561        /* Extract list */
1562        temp= env->head;
1563        env->head= iterator->next;
1564        iterator->next= NULL;
1565    
1566        pack->type= list;
1567        pack->content.ptr= temp;
1568        
1569        if(env->head!=NULL)
1570          toss(env);
1571      }
1572    
1573      /* Push list */
1574    
1575      push_val(env, pack);
1576    
1577      unprotect(pack);
1578  }  }
1579    
1580  /* Read a string */  /* Read a string */
1581  extern void readline(environment *env) {  extern void readline(environment *env)
1582    {
1583    char in_string[101];    char in_string[101];
1584    
1585    if(fgets(in_string, 100, env->inputstream)==NULL)    if(fgets(in_string, 100, env->inputstream)==NULL)
# Line 1363  extern void readline(environment *env) { Line 1589  extern void readline(environment *env) {
1589  }  }
1590    
1591  /* "read"; Read a value and place on stack */  /* "read"; Read a value and place on stack */
1592  extern void sx_72656164(environment *env) {  extern void sx_72656164(environment *env)
1593    {
1594    const char symbform[]= "%[a-zA-Z0-9!$%*+./:<=>?@^_~-]%n";    const char symbform[]= "%[a-zA-Z0-9!$%*+./:<=>?@^_~-]%n";
1595    const char strform[]= "\"%[^\"]\"%n";    const char strform[]= "\"%[^\"]\"%n";
1596    const char intform[]= "%i%n";    const char intform[]= "%i%n";
1597      const char fltform[]= "%f%n";
1598    const char blankform[]= "%*[ \t]%n";    const char blankform[]= "%*[ \t]%n";
1599    const char ebrackform[]= "]%n";    const char ebrackform[]= "]%n";
1600    const char semicform[]= ";%n";    const char semicform[]= ";%n";
1601    const char bbrackform[]= "[%n";    const char bbrackform[]= "[%n";
1602    
1603    int itemp, readlength= -1;    int itemp, readlength= -1;
1604      int count= -1;
1605      float ftemp;
1606    static int depth= 0;    static int depth= 0;
1607    char *match;    char *match, *ctemp;
1608    size_t inlength;    size_t inlength;
1609    
1610    if(env->in_string==NULL) {    if(env->in_string==NULL) {
# Line 1397  extern void sx_72656164(environment *env Line 1627  extern void sx_72656164(environment *env
1627    inlength= strlen(env->in_string)+1;    inlength= strlen(env->in_string)+1;
1628    match= malloc(inlength);    match= malloc(inlength);
1629    
1630    if(sscanf(env->in_string, blankform, &readlength)!=EOF    if(sscanf(env->in_string, blankform, &readlength) != EOF
1631       && readlength != -1) {       && readlength != -1) {
1632      ;      ;
1633    } else if(sscanf(env->in_string, intform, &itemp, &readlength) != EOF    } else if(sscanf(env->in_string, fltform, &ftemp, &readlength) != EOF
1634              && readlength != -1) {              && readlength != -1) {
1635      push_int(env, itemp);      if(sscanf(env->in_string, intform, &itemp, &count) != EOF
1636           && count==readlength) {
1637          push_int(env, itemp);
1638        } else {
1639          push_float(env, ftemp);
1640        }
1641    } else if(sscanf(env->in_string, strform, match, &readlength) != EOF    } else if(sscanf(env->in_string, strform, match, &readlength) != EOF
1642              && readlength != -1) {              && readlength != -1) {
1643      push_cstring(env, match);      push_cstring(env, match);
# Line 1424  extern void sx_72656164(environment *env Line 1659  extern void sx_72656164(environment *env
1659      free(env->free_string);      free(env->free_string);
1660      env->in_string = env->free_string = NULL;      env->in_string = env->free_string = NULL;
1661    }    }
1662    if ( env->in_string != NULL) {    if (env->in_string != NULL) {
1663      env->in_string += readlength;      env->in_string += readlength;
1664    }    }
1665    
# Line 1434  extern void sx_72656164(environment *env Line 1669  extern void sx_72656164(environment *env
1669      return sx_72656164(env);      return sx_72656164(env);
1670  }  }
1671    
1672  extern void beep(environment *env) {  extern void beep(environment *env)
1673    {
1674    int freq, dur, period, ticks;    int freq, dur, period, ticks;
1675    
1676    if((env->head)==NULL || env->head->next==NULL) {    if((env->head)==NULL || env->head->next==NULL) {
# Line 1451  extern void beep(environment *env) { Line 1686  extern void beep(environment *env) {
1686      return;      return;
1687    }    }
1688    
1689    dur=env->head->item->content.val;    dur=env->head->item->content.i;
1690    toss(env);    toss(env);
1691    freq=env->head->item->content.val;    freq=env->head->item->content.i;
1692    toss(env);    toss(env);
1693    
1694    period=1193180/freq;          /* convert freq from Hz to period    period=1193180/freq;          /* convert freq from Hz to period
# Line 1475  extern void beep(environment *env) { Line 1710  extern void beep(environment *env) {
1710    default:    default:
1711      abort();      abort();
1712    }    }
1713  };  }
1714    
1715  /* "wait" */  /* "wait" */
1716  extern void sx_77616974(environment *env) {  extern void sx_77616974(environment *env)
1717    {
1718    int dur;    int dur;
1719    
1720    if((env->head)==NULL) {    if((env->head)==NULL) {
# Line 1494  extern void sx_77616974(environment *env Line 1729  extern void sx_77616974(environment *env
1729      return;      return;
1730    }    }
1731    
1732    dur=env->head->item->content.val;    dur=env->head->item->content.i;
1733    toss(env);    toss(env);
1734    
1735    usleep(dur);    usleep(dur);
1736  };  }
1737    
1738  extern void copying(environment *env){  extern void copying(environment *env)
1739    {
1740    printf("GNU GENERAL PUBLIC LICENSE\n\    printf("GNU GENERAL PUBLIC LICENSE\n\
1741                         Version 2, June 1991\n\                         Version 2, June 1991\n\
1742  \n\  \n\
# Line 1759  of preserving the free status of all der Line 1995  of preserving the free status of all der
1995  of promoting the sharing and reuse of software generally.\n");  of promoting the sharing and reuse of software generally.\n");
1996  }  }
1997    
1998  extern void warranty(environment *env){  extern void warranty(environment *env)
1999    {
2000    printf("                          NO WARRANTY\n\    printf("                          NO WARRANTY\n\
2001  \n\  \n\
2002    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 2024  POSSIBILITY OF SUCH DAMAGES.\n");
2024  extern void sx_2a(environment *env)  extern void sx_2a(environment *env)
2025  {  {
2026    int a, b;    int a, b;
2027      float fa, fb;
2028    
2029    if((env->head)==NULL || env->head->next==NULL) {    if((env->head)==NULL || env->head->next==NULL) {
2030      printerr("Too Few Arguments");      printerr("Too Few Arguments");
# Line 1794  extern void sx_2a(environment *env) Line 2032  extern void sx_2a(environment *env)
2032      return;      return;
2033    }    }
2034        
2035    if(env->head->item->type!=integer    if(env->head->item->type==integer
2036       || env->head->next->item->type!=integer) {       && env->head->next->item->type==integer) {
2037      printerr("Bad Argument Type");      a=env->head->item->content.i;
2038      env->err=2;      toss(env); if(env->err) return;
2039        b=env->head->item->content.i;
2040        toss(env); if(env->err) return;
2041        push_int(env, b*a);
2042    
2043      return;      return;
2044    }    }
2045    
2046    a=env->head->item->content.val;    if(env->head->item->type==tfloat
2047    toss(env); if(env->err) return;       && env->head->next->item->type==tfloat) {
2048    b=env->head->item->content.val;      fa= env->head->item->content.f;
2049    toss(env); if(env->err) return;      toss(env); if(env->err) return;
2050    push_int(env, b*a);      fb= env->head->item->content.f;
2051        toss(env); if(env->err) return;
2052        push_float(env, fb*fa);
2053        
2054        return;
2055      }
2056    
2057      if(env->head->item->type==tfloat
2058         && env->head->next->item->type==integer) {
2059        fa= env->head->item->content.f;
2060        toss(env); if(env->err) return;
2061        b= env->head->item->content.i;
2062        toss(env); if(env->err) return;
2063        push_float(env, b*fa);
2064        
2065        return;
2066      }
2067    
2068      if(env->head->item->type==integer
2069         && env->head->next->item->type==tfloat) {
2070        a= env->head->item->content.i;
2071        toss(env); if(env->err) return;
2072        fb= env->head->item->content.f;
2073        toss(env); if(env->err) return;
2074        push_float(env, fb*a);
2075    
2076        return;
2077      }
2078    
2079      printerr("Bad Argument Type");
2080      env->err=2;
2081  }  }
2082    
2083  /* "/" */  /* "/" */
2084  extern void sx_2f(environment *env)  extern void sx_2f(environment *env)
2085  {  {
2086    int a, b;    int a, b;
2087      float fa, fb;
2088    
2089    if((env->head)==NULL || env->head->next==NULL) {    if((env->head)==NULL || env->head->next==NULL) {
2090      printerr("Too Few Arguments");      printerr("Too Few Arguments");
# Line 1819  extern void sx_2f(environment *env) Line 2092  extern void sx_2f(environment *env)
2092      return;      return;
2093    }    }
2094        
2095    if(env->head->item->type!=integer    if(env->head->item->type==integer
2096       || env->head->next->item->type!=integer) {       && env->head->next->item->type==integer) {
2097      printerr("Bad Argument Type");      a=env->head->item->content.i;
2098      env->err=2;      toss(env); if(env->err) return;
2099        b=env->head->item->content.i;
2100        toss(env); if(env->err) return;
2101        push_float(env, b/a);
2102    
2103      return;      return;
2104    }    }
2105    
2106    a=env->head->item->content.val;    if(env->head->item->type==tfloat
2107    toss(env); if(env->err) return;       && env->head->next->item->type==tfloat) {
2108    b=env->head->item->content.val;      fa= env->head->item->content.f;
2109    toss(env); if(env->err) return;      toss(env); if(env->err) return;
2110    push_int(env, b/a);      fb= env->head->item->content.f;
2111        toss(env); if(env->err) return;
2112        push_float(env, fb/fa);
2113        
2114        return;
2115      }
2116    
2117      if(env->head->item->type==tfloat
2118         && env->head->next->item->type==integer) {
2119        fa= env->head->item->content.f;
2120        toss(env); if(env->err) return;
2121        b= env->head->item->content.i;
2122        toss(env); if(env->err) return;
2123        push_float(env, b/fa);
2124        
2125        return;
2126      }
2127    
2128      if(env->head->item->type==integer
2129         && env->head->next->item->type==tfloat) {
2130        a= env->head->item->content.i;
2131        toss(env); if(env->err) return;
2132        fb= env->head->item->content.f;
2133        toss(env); if(env->err) return;
2134        push_float(env, fb/a);
2135    
2136        return;
2137      }
2138    
2139      printerr("Bad Argument Type");
2140      env->err=2;
2141  }  }
2142    
2143  /* "mod" */  /* "mod" */
# Line 1840  extern void mod(environment *env) Line 2147  extern void mod(environment *env)
2147    
2148    if((env->head)==NULL || env->head->next==NULL) {    if((env->head)==NULL || env->head->next==NULL) {
2149      printerr("Too Few Arguments");      printerr("Too Few Arguments");
2150      env->err=1;      env->err= 1;
2151      return;      return;
2152    }    }
2153        
2154    if(env->head->item->type!=integer    if(env->head->item->type==integer
2155       || env->head->next->item->type!=integer) {       && env->head->next->item->type==integer) {
2156      printerr("Bad Argument Type");      a= env->head->item->content.i;
2157      env->err=2;      toss(env); if(env->err) return;
2158        b= env->head->item->content.i;
2159        toss(env); if(env->err) return;
2160        push_int(env, b%a);
2161    
2162      return;      return;
2163    }    }
2164    
2165    a=env->head->item->content.val;    printerr("Bad Argument Type");
2166    toss(env); if(env->err) return;    env->err=2;
2167    b=env->head->item->content.val;  }
2168    toss(env); if(env->err) return;  
2169    push_int(env, b%a);  /* "div" */
2170    extern void sx_646976(environment *env)
2171    {
2172      int a, b;
2173      
2174      if((env->head)==NULL || env->head->next==NULL) {
2175        printerr("Too Few Arguments");
2176        env->err= 1;
2177        return;
2178      }
2179    
2180      if(env->head->item->type==integer
2181         && env->head->next->item->type==integer) {
2182        a= env->head->item->content.i;
2183        toss(env); if(env->err) return;
2184        b= env->head->item->content.i;
2185        toss(env); if(env->err) return;
2186        push_int(env, (int)b/a);
2187    
2188        return;
2189      }
2190    
2191      printerr("Bad Argument Type");
2192      env->err= 2;
2193  }  }
Legend:
Removed from v.1.92  
changed lines
  Added in v.1.98
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26