/[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.100 by teddy, Sun Mar 10 12:05:20 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= 400000;
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 80  extern void toss(environment *env) Line 80  extern void toss(environment *env)
80        
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 */
   
   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    env->gc_ref= nitem;    env->gc_ref= nitem;
125    
126    env->gc_count++;    env->gc_count+=sizeof(value);
127    unprotect(env);    nval->gc.flag.mark= 0;
128      nval->gc.flag.protect= 0;
129    
130    return nval;    return nval;
131  }  }
132    
133  void gc_mark(value *val) {  /* Mark values recursively.
134       Marked values are not collected by the GC. */
135    inline void gc_mark(value *val)
136    {
137    stackitem *iterator;    stackitem *iterator;
138    
139    if(val==NULL || val->gc_garb==0)    if(val->gc.flag.mark)
140      return;      return;
141    
142    val->gc_garb= 0;    val->gc.flag.mark= 1;
143    
144    if(val->type==list) {    if(val->type==list) {
145      iterator= val->content.ptr;      iterator= val->content.ptr;
# Line 150  void gc_mark(value *val) { Line 151  void gc_mark(value *val) {
151    }    }
152  }  }
153    
154  extern void gc_init(environment *env) {  inline void gc_maybe(environment *env)
155    stackitem *new_head= NULL, *titem, *iterator= env->gc_ref;  {
   symbol *tsymb;  
   int i;  
   
156    if(env->gc_count < env->gc_limit)    if(env->gc_count < env->gc_limit)
157      return;      return;
158      else
159        return gc_init(env);
160    }
161    
162    while(iterator!=NULL) {  /* Start GC */
163      iterator->item->gc_garb= 1;  extern void gc_init(environment *env)
164      iterator= iterator->next;  {
165    }    stackitem *new_head= NULL, *titem, *iterator;
166      symbol *tsymb;
167      int i;
168    
169    /* Mark */    if(env->interactive){
170    iterator= env->gc_protect;      printf("Garbage collecting.", env->gc_count, env->gc_limit);
   while(iterator!=NULL) {  
     gc_mark(iterator->item);  
     iterator= iterator->next;  
171    }    }
172    
173      /* Mark values on stack */
174    iterator= env->head;    iterator= env->head;
175    while(iterator!=NULL) {    while(iterator!=NULL) {
176      gc_mark(iterator->item);      gc_mark(iterator->item);
177      iterator= iterator->next;      iterator= iterator->next;
178    }    }
179    
180      if(env->interactive){
181        printf(".");
182      }
183    
184      /* Mark values in hashtable */
185    for(i= 0; i<HASHTBLSIZE; i++) {    for(i= 0; i<HASHTBLSIZE; i++) {
186      tsymb= env->symbols[i];      tsymb= env->symbols[i];
187      while(tsymb!=NULL) {      while(tsymb!=NULL) {
188        gc_mark(tsymb->val);        if (tsymb->val != NULL)
189            gc_mark(tsymb->val);
190        tsymb= tsymb->next;        tsymb= tsymb->next;
191      }      }
192    }    }
193    
194      if(env->interactive){
195        printf(".");
196      }
197    
198    env->gc_count= 0;    env->gc_count= 0;
199    
200    /* Sweep */    while(env->gc_ref!=NULL) {    /* Sweep unused values */
201    while(env->gc_ref!=NULL) {  
202        if(!(env->gc_ref->item->gc.no_gc)){ /* neither mark nor protect */
203    
204      if(env->gc_ref->item->gc_garb) {        switch(env->gc_ref->item->type) { /* Remove content */
       switch(env->gc_ref->item->type) {  
205        case string:        case string:
206          free(env->gc_ref->item->content.ptr);          free(env->gc_ref->item->content.ptr);
207          break;          break;
       case integer:  
         break;  
208        case list:        case list:
209          while(env->gc_ref->item->content.ptr!=NULL) {          while(env->gc_ref->item->content.ptr!=NULL) {
210            titem= env->gc_ref->item->content.ptr;            titem= env->gc_ref->item->content.ptr;
211            env->gc_ref->item->content.ptr= titem->next;            env->gc_ref->item->content.ptr= titem->next;
212            free(titem);            free(titem);
213          }          }
         break;  
214        default:        default:
         break;  
215        }        }
216        free(env->gc_ref->item);        free(env->gc_ref->item);  /* Remove from gc_ref */
217        titem= env->gc_ref->next;        titem= env->gc_ref->next;
218        free(env->gc_ref);        free(env->gc_ref);        /* Remove value */
219        env->gc_ref= titem;        env->gc_ref= titem;
220          continue;
221      } else {      } else {
222        titem= env->gc_ref->next;        env->gc_count += sizeof(value);
       env->gc_ref->next= new_head;  
       new_head= env->gc_ref;  
       env->gc_ref= titem;  
       env->gc_count++;  
223      }      }
224        
225        /* Keep values */
226        titem= env->gc_ref->next;
227        env->gc_ref->next= new_head;
228        new_head= env->gc_ref;
229        new_head->item->gc.flag.mark= 0;
230        env->gc_ref= titem;
231    }    }
232    
233    env->gc_limit= env->gc_count*2;    if (env->gc_limit < env->gc_count*2)
234        env->gc_limit= env->gc_count*2;
235    env->gc_ref= new_head;    env->gc_ref= new_head;
236    
237      if(env->interactive){
238        printf("done\n");
239      }
240    
241  }  }
242    
243  void protect(environment *env, value *val)  /* Protect values from GC */
244    void protect(value *val)
245  {  {
246    stackitem *new_item= malloc(sizeof(stackitem));    stackitem *iterator;
247    new_item->item= val;  
248    new_item->next= env->gc_protect;    if(val->gc.flag.protect)
249    env->gc_protect= new_item;      return;
250    
251      val->gc.flag.protect= 1;
252    
253      if(val->type==list) {
254        iterator= val->content.ptr;
255    
256        while(iterator!=NULL) {
257          protect(iterator->item);
258          iterator= iterator->next;
259        }
260      }
261  }  }
262    
263  void unprotect(environment *env)  /* Unprotect values from GC */
264    void unprotect(value *val)
265  {  {
266    stackitem *temp= env->gc_protect;    stackitem *iterator;
267    env->gc_protect= env->gc_protect->next;  
268    free(temp);    if(!(val->gc.flag.protect))
269        return;
270    
271      val->gc.flag.protect= 0;
272    
273      if(val->type==list) {
274        iterator= val->content.ptr;
275    
276        while(iterator!=NULL) {
277          unprotect(iterator->item);
278          iterator= iterator->next;
279        }
280      }
281  }  }
282    
283  /* Push a value onto the stack */  /* Push a value onto the stack */
# Line 247  void push_val(environment *env, value *v Line 289  void push_val(environment *env, value *v
289    env->head= new_item;    env->head= new_item;
290  }  }
291    
292  /* Push an integer onto the stack. */  /* Push an integer onto the stack */
293  void push_int(environment *env, int in_val)  void push_int(environment *env, int in_val)
294  {  {
295    value *new_value= new_val(env);    value *new_value= new_val(env);
296        
297    new_value->content.val= in_val;    new_value->content.i= in_val;
298    new_value->type= integer;    new_value->type= integer;
299    
300    push_val(env, new_value);    push_val(env, new_value);
301  }  }
302    
303    /* Push a floating point number onto the stack */
304    void push_float(environment *env, float in_val)
305    {
306      value *new_value= new_val(env);
307    
308      new_value->content.f= in_val;
309      new_value->type= tfloat;
310    
311      push_val(env, new_value);
312    }
313    
314  /* Copy a string onto the stack. */  /* Copy a string onto the stack. */
315  void push_cstring(environment *env, const char *in_string)  void push_cstring(environment *env, const char *in_string)
316  {  {
# Line 271  void push_cstring(environment *env, cons Line 324  void push_cstring(environment *env, cons
324  }  }
325    
326  /* Mangle a symbol name to a valid C identifier name */  /* Mangle a symbol name to a valid C identifier name */
327  char *mangle_str(const char *old_string){  char *mangle_str(const char *old_string)
328    {
329    char validchars[]= "0123456789abcdef";    char validchars[]= "0123456789abcdef";
330    char *new_string, *current;    char *new_string, *current;
331    
# Line 289  char *mangle_str(const char *old_string) Line 343  char *mangle_str(const char *old_string)
343    return new_string;            /* The caller must free() it */    return new_string;            /* The caller must free() it */
344  }  }
345    
346  extern void mangle(environment *env){  extern void mangle(environment *env)
347    {
348    char *new_string;    char *new_string;
349    
350    if((env->head)==NULL) {    if((env->head)==NULL) {
# Line 328  void push_sym(environment *env, const ch Line 383  void push_sym(environment *env, const ch
383    char *mangled;                /* Mangled function name */    char *mangled;                /* Mangled function name */
384    
385    new_value= new_val(env);    new_value= new_val(env);
386      protect(new_value);
387      new_fvalue= new_val(env);
388      protect(new_fvalue);
389    
390    /* The new value is a symbol */    /* The new value is a symbol */
391    new_value->type= symb;    new_value->type= symb;
# Line 355  void push_sym(environment *env, const ch Line 413  void push_sym(environment *env, const ch
413    
414      mangled= mangle_str(in_string); /* mangle the name */      mangled= mangle_str(in_string); /* mangle the name */
415      funcptr= dlsym(handle, mangled); /* and try to find it */      funcptr= dlsym(handle, mangled); /* and try to find it */
416      free(mangled);  
417      dlerr= dlerror();      dlerr= dlerror();
418      if(dlerr != NULL) {         /* If no function was found */      if(dlerr != NULL) {         /* If no function was found */
419        funcptr= dlsym(handle, in_string); /* Get function pointer */        funcptr= dlsym(handle, in_string); /* Get function pointer */
420        dlerr= dlerror();        dlerr= dlerror();
421      }      }
422    
423      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 */  
424        new_fvalue->type= func;   /* The new value is a function pointer */        new_fvalue->type= func;   /* The new value is a function pointer */
425        new_fvalue->content.ptr= funcptr; /* Store function pointer */        new_fvalue->content.ptr= funcptr; /* Store function pointer */
426        (*new_symbol)->val= new_fvalue; /* Bind the symbol to the new        (*new_symbol)->val= new_fvalue; /* Bind the symbol to the new
427                                           function value */                                           function value */
428      }      }
429    
430        free(mangled);
431    }    }
432    
433    push_val(env, new_value);    push_val(env, new_value);
434      unprotect(new_value); unprotect(new_fvalue);
435  }  }
436    
437  /* Print newline. */  /* Print newline. */
# Line 379  extern void nl() Line 441  extern void nl()
441  }  }
442    
443  /* Gets the type of a value */  /* Gets the type of a value */
444  extern void type(environment *env){  extern void type(environment *env)
445    {
446    int typenum;    int typenum;
447    
448    if((env->head)==NULL) {    if((env->head)==NULL) {
# Line 393  extern void type(environment *env){ Line 456  extern void type(environment *env){
456    case integer:    case integer:
457      push_sym(env, "integer");      push_sym(env, "integer");
458      break;      break;
459      case tfloat:
460        push_sym(env, "float");
461        break;
462    case string:    case string:
463      push_sym(env, "string");      push_sym(env, "string");
464      break;      break;
# Line 413  void print_h(stackitem *stack_head, int Line 479  void print_h(stackitem *stack_head, int
479  {  {
480    switch(stack_head->item->type) {    switch(stack_head->item->type) {
481    case integer:    case integer:
482      printf("%d", stack_head->item->content.val);      printf("%d", stack_head->item->content.i);
483        break;
484      case tfloat:
485        printf("%f", stack_head->item->content.f);
486      break;      break;
487    case string:    case string:
488      if(noquote)      if(noquote)
# Line 441  void print_h(stackitem *stack_head, int Line 510  void print_h(stackitem *stack_head, int
510    }    }
511  }  }
512    
513  extern void print_(environment *env) {  extern void print_(environment *env)
514    {
515    if(env->head==NULL) {    if(env->head==NULL) {
516      printerr("Too Few Arguments");      printerr("Too Few Arguments");
517      env->err=1;      env->err=1;
# Line 459  extern void print(environment *env) Line 529  extern void print(environment *env)
529    toss(env);    toss(env);
530  }  }
531    
532  extern void princ_(environment *env) {  extern void princ_(environment *env)
533    {
534    if(env->head==NULL) {    if(env->head==NULL) {
535      printerr("Too Few Arguments");      printerr("Too Few Arguments");
536      env->err=1;      env->err=1;
# Line 493  extern void printstack(environment *env) Line 564  extern void printstack(environment *env)
564      printf("Stack Empty\n");      printf("Stack Empty\n");
565      return;      return;
566    }    }
567    
568    print_st(env->head, 1);    print_st(env->head, 1);
569  }  }
570    
# Line 552  extern void rcl(environment *env) Line 624  extern void rcl(environment *env)
624      env->err=3;      env->err=3;
625      return;      return;
626    }    }
627    protect(env, val);    protect(val);
628    toss(env);            /* toss the symbol */    toss(env);            /* toss the symbol */
629    if(env->err) return;    if(env->err) return;
630    push_val(env, val); /* Return its bound value */    push_val(env, val); /* Return its bound value */
631    unprotect(env);    unprotect(val);
632  }  }
633    
634  /* 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 642  extern void eval(environment *env)
642    
643   eval_start:   eval_start:
644    
645      gc_maybe(env);
646    
647    if(env->head==NULL) {    if(env->head==NULL) {
648      printerr("Too Few Arguments");      printerr("Too Few Arguments");
649      env->err=1;      env->err=1;
# Line 596  extern void eval(environment *env) Line 670  extern void eval(environment *env)
670      /* If it's a list */      /* If it's a list */
671    case list:    case list:
672      temp_val= env->head->item;      temp_val= env->head->item;
673      protect(env, temp_val);      protect(temp_val);
674      toss(env);  
675      if(env->err) return;      toss(env); if(env->err) return;
676      iterator= (stackitem*)temp_val->content.ptr;      iterator= (stackitem*)temp_val->content.ptr;
     unprotect(env);  
677            
678      while(iterator!=NULL) {      while(iterator!=NULL) {
679        push_val(env, iterator->item);        push_val(env, iterator->item);
680                
681        if(env->head->item->type==symb        if(env->head->item->type==symb
682          && strcmp(";", ((symbol*)(env->head->item->content.ptr))->id)==0) {           && (((symbol*)(env->head->item->content.ptr))->id[0] == ';')) {
683          toss(env);          toss(env);
684          if(env->err) return;          if(env->err) return;
685                    
# Line 618  extern void eval(environment *env) Line 691  extern void eval(environment *env)
691        }        }
692        iterator= iterator->next;        iterator= iterator->next;
693      }      }
694        unprotect(temp_val);
695      return;      return;
696    
697    default:    default:
# Line 626  extern void eval(environment *env) Line 700  extern void eval(environment *env)
700  }  }
701    
702  /* Reverse (flip) a list */  /* Reverse (flip) a list */
703  extern void rev(environment *env){  extern void rev(environment *env)
704    {
705    stackitem *old_head, *new_head, *item;    stackitem *old_head, *new_head, *item;
706    
707    if((env->head)==NULL) {    if((env->head)==NULL) {
# Line 659  extern void pack(environment *env) Line 734  extern void pack(environment *env)
734    value *pack;    value *pack;
735    
736    iterator= env->head;    iterator= env->head;
737      pack= new_val(env);
738      protect(pack);
739    
740    if(iterator==NULL    if(iterator==NULL
741       || (iterator->item->type==symb       || (iterator->item->type==symb
# Line 676  extern void pack(environment *env) Line 753  extern void pack(environment *env)
753      temp= env->head;      temp= env->head;
754      env->head= iterator->next;      env->head= iterator->next;
755      iterator->next= NULL;      iterator->next= NULL;
756    
757        pack->type= list;
758        pack->content.ptr= temp;
759            
760      if(env->head!=NULL)      if(env->head!=NULL)
761        toss(env);        toss(env);
762    }    }
763    
764    /* Push list */    /* Push list */
   pack= new_val(env);  
   pack->type= list;  
   pack->content.ptr= temp;  
765    
766    push_val(env, pack);    push_val(env, pack);
767    rev(env);    rev(env);
768    
769      unprotect(pack);
770  }  }
771    
772  /* Relocate elements of the list on the stack. */  /* Relocate elements of the list on the stack. */
# Line 765  extern void not(environment *env) Line 844  extern void not(environment *env)
844      return;      return;
845    }    }
846    
847    val= env->head->item->content.val;    val= env->head->item->content.i;
848    toss(env);    toss(env);
849    push_int(env, !val);    push_int(env, !val);
850  }  }
# Line 808  extern void def(environment *env) Line 887  extern void def(environment *env)
887  /* Quit stack. */  /* Quit stack. */
888  extern void quit(environment *env)  extern void quit(environment *env)
889  {  {
890    long i;    int i;
891    
892    clear(env);    clear(env);
893    
# Line 821  extern void quit(environment *env) Line 900  extern void quit(environment *env)
900    }    }
901    
902    env->gc_limit= 0;    env->gc_limit= 0;
903    gc_init(env);    gc_maybe(env);
904    
905    if(env->free_string!=NULL)    if(env->free_string!=NULL)
906      free(env->free_string);      free(env->free_string);
# Line 854  extern void words(environment *env) Line 933  extern void words(environment *env)
933  }  }
934    
935  /* Internal forget function */  /* Internal forget function */
936  void forget_sym(symbol **hash_entry) {  void forget_sym(symbol **hash_entry)
937    {
938    symbol *temp;    symbol *temp;
939    
940    temp= *hash_entry;    temp= *hash_entry;
# Line 889  extern void forget(environment *env) Line 969  extern void forget(environment *env)
969  }  }
970    
971  /* Returns the current error number to the stack */  /* Returns the current error number to the stack */
972  extern void errn(environment *env){  extern void errn(environment *env)
973    {
974    push_int(env, env->err);    push_int(env, env->err);
975  }  }
976    
# Line 958  under certain conditions; type `copying; Line 1039  under certain conditions; type `copying;
1039        toss(&myenv);             /* No error check in main */        toss(&myenv);             /* No error check in main */
1040        eval(&myenv);        eval(&myenv);
1041      }      }
1042      gc_init(&myenv);      gc_maybe(&myenv);
1043    }    }
1044    quit(&myenv);    quit(&myenv);
1045    return EXIT_FAILURE;    return EXIT_FAILURE;
1046  }  }
1047    
1048  /* "+" */  /* "+" */
1049  extern void sx_2b(environment *env) {  extern void sx_2b(environment *env)
1050    {
1051    int a, b;    int a, b;
1052      float fa, fb;
1053    size_t len;    size_t len;
1054    char* new_string;    char* new_string;
1055    value *a_val, *b_val;    value *a_val, *b_val;
# Line 981  extern void sx_2b(environment *env) { Line 1064  extern void sx_2b(environment *env) {
1064       && env->head->next->item->type==string) {       && env->head->next->item->type==string) {
1065      a_val= env->head->item;      a_val= env->head->item;
1066      b_val= env->head->next->item;      b_val= env->head->next->item;
1067      protect(env, a_val); protect(env, b_val);      protect(a_val); protect(b_val);
1068      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1069      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1070      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 1072  extern void sx_2b(environment *env) {
1072      strcpy(new_string, b_val->content.ptr);      strcpy(new_string, b_val->content.ptr);
1073      strcat(new_string, a_val->content.ptr);      strcat(new_string, a_val->content.ptr);
1074      push_cstring(env, new_string);      push_cstring(env, new_string);
1075      unprotect(env); unprotect(env);      unprotect(a_val); unprotect(b_val);
1076      free(new_string);      free(new_string);
1077        
1078      return;      return;
1079    }    }
1080        
1081    if(env->head->item->type!=integer    if(env->head->item->type==integer
1082       || env->head->next->item->type!=integer) {       && env->head->next->item->type==integer) {
1083      printerr("Bad Argument Type");      a=env->head->item->content.i;
1084      env->err=2;      toss(env); if(env->err) return;
1085        b=env->head->item->content.i;
1086        toss(env); if(env->err) return;
1087        push_int(env, b+a);
1088    
1089      return;      return;
1090    }    }
1091    a= env->head->item->content.val;  
1092    toss(env); if(env->err) return;    if(env->head->item->type==tfloat
1093           && env->head->next->item->type==tfloat) {
1094    b= env->head->item->content.val;      fa= env->head->item->content.f;
1095    toss(env); if(env->err) return;      toss(env); if(env->err) return;
1096    push_int(env, a+b);      fb= env->head->item->content.f;
1097        toss(env); if(env->err) return;
1098        push_float(env, fb+fa);
1099        
1100        return;
1101      }
1102    
1103      if(env->head->item->type==tfloat
1104         && env->head->next->item->type==integer) {
1105        fa= env->head->item->content.f;
1106        toss(env); if(env->err) return;
1107        b= env->head->item->content.i;
1108        toss(env); if(env->err) return;
1109        push_float(env, b+fa);
1110        
1111        return;
1112      }
1113    
1114      if(env->head->item->type==integer
1115         && env->head->next->item->type==tfloat) {
1116        a= env->head->item->content.i;
1117        toss(env); if(env->err) return;
1118        fb= env->head->item->content.f;
1119        toss(env); if(env->err) return;
1120        push_float(env, fb+a);
1121    
1122        return;
1123      }
1124    
1125      printerr("Bad Argument Type");
1126      env->err=2;
1127  }  }
1128    
1129  /* "-" */  /* "-" */
1130  extern void sx_2d(environment *env) {  extern void sx_2d(environment *env)
1131    {
1132    int a, b;    int a, b;
1133      float fa, fb;
1134    
1135    if((env->head)==NULL || env->head->next==NULL) {    if((env->head)==NULL || env->head->next==NULL) {
1136      printerr("Too Few Arguments");      printerr("Too Few Arguments");
# Line 1018  extern void sx_2d(environment *env) { Line 1138  extern void sx_2d(environment *env) {
1138      return;      return;
1139    }    }
1140        
1141    if(env->head->item->type!=integer    if(env->head->item->type==integer
1142       || env->head->next->item->type!=integer) {       && env->head->next->item->type==integer) {
1143      printerr("Bad Argument Type");      a=env->head->item->content.i;
1144      env->err=2;      toss(env); if(env->err) return;
1145        b=env->head->item->content.i;
1146        toss(env); if(env->err) return;
1147        push_int(env, b-a);
1148    
1149      return;      return;
1150    }    }
1151    
1152    a=env->head->item->content.val;    if(env->head->item->type==tfloat
1153    toss(env); if(env->err) return;       && env->head->next->item->type==tfloat) {
1154    b=env->head->item->content.val;      fa= env->head->item->content.f;
1155    toss(env); if(env->err) return;      toss(env); if(env->err) return;
1156    push_int(env, b-a);      fb= env->head->item->content.f;
1157        toss(env); if(env->err) return;
1158        push_float(env, fb-fa);
1159        
1160        return;
1161      }
1162    
1163      if(env->head->item->type==tfloat
1164         && env->head->next->item->type==integer) {
1165        fa= env->head->item->content.f;
1166        toss(env); if(env->err) return;
1167        b= env->head->item->content.i;
1168        toss(env); if(env->err) return;
1169        push_float(env, b-fa);
1170        
1171        return;
1172      }
1173    
1174      if(env->head->item->type==integer
1175         && env->head->next->item->type==tfloat) {
1176        a= env->head->item->content.i;
1177        toss(env); if(env->err) return;
1178        fb= env->head->item->content.f;
1179        toss(env); if(env->err) return;
1180        push_float(env, fb-a);
1181    
1182        return;
1183      }
1184    
1185      printerr("Bad Argument Type");
1186      env->err=2;
1187  }  }
1188    
1189  /* ">" */  /* ">" */
1190  extern void sx_3e(environment *env) {  extern void sx_3e(environment *env)
1191    {
1192    int a, b;    int a, b;
1193      float fa, fb;
1194    
1195    if((env->head)==NULL || env->head->next==NULL) {    if((env->head)==NULL || env->head->next==NULL) {
1196      printerr("Too Few Arguments");      printerr("Too Few Arguments");
# Line 1042  extern void sx_3e(environment *env) { Line 1198  extern void sx_3e(environment *env) {
1198      return;      return;
1199    }    }
1200        
1201    if(env->head->item->type!=integer    if(env->head->item->type==integer
1202       || env->head->next->item->type!=integer) {       && env->head->next->item->type==integer) {
1203      printerr("Bad Argument Type");      a=env->head->item->content.i;
1204      env->err=2;      toss(env); if(env->err) return;
1205        b=env->head->item->content.i;
1206        toss(env); if(env->err) return;
1207        push_int(env, b>a);
1208    
1209      return;      return;
1210    }    }
1211    
1212    a=env->head->item->content.val;    if(env->head->item->type==tfloat
1213    toss(env); if(env->err) return;       && env->head->next->item->type==tfloat) {
1214    b=env->head->item->content.val;      fa= env->head->item->content.f;
1215    toss(env); if(env->err) return;      toss(env); if(env->err) return;
1216    push_int(env, b>a);      fb= env->head->item->content.f;
1217        toss(env); if(env->err) return;
1218        push_int(env, fb>fa);
1219        
1220        return;
1221      }
1222    
1223      if(env->head->item->type==tfloat
1224         && env->head->next->item->type==integer) {
1225        fa= env->head->item->content.f;
1226        toss(env); if(env->err) return;
1227        b= env->head->item->content.i;
1228        toss(env); if(env->err) return;
1229        push_int(env, b>fa);
1230        
1231        return;
1232      }
1233    
1234      if(env->head->item->type==integer
1235         && env->head->next->item->type==tfloat) {
1236        a= env->head->item->content.i;
1237        toss(env); if(env->err) return;
1238        fb= env->head->item->content.f;
1239        toss(env); if(env->err) return;
1240        push_int(env, fb>a);
1241    
1242        return;
1243      }
1244    
1245      printerr("Bad Argument Type");
1246      env->err=2;
1247    }
1248    
1249    /* "<" */
1250    extern void sx_3c(environment *env)
1251    {
1252      swap(env); if(env->err) return;
1253      sx_3e(env);
1254    }
1255    
1256    /* "<=" */
1257    extern void sx_3c3d(environment *env)
1258    {
1259      sx_3e(env); if(env->err) return;
1260      not(env);
1261    }
1262    
1263    /* ">=" */
1264    extern void sx_3e3d(environment *env)
1265    {
1266      sx_3c(env); if(env->err) return;
1267      not(env);
1268  }  }
1269    
1270  /* Return copy of a value */  /* Return copy of a value */
1271  value *copy_val(environment *env, value *old_value){  value *copy_val(environment *env, value *old_value)
1272    {
1273    stackitem *old_item, *new_item, *prev_item;    stackitem *old_item, *new_item, *prev_item;
1274      value *new_value;
1275    
1276    value *new_value= new_val(env);    protect(old_value);
1277      new_value= new_val(env);
1278    protect(env, old_value);    protect(new_value);
1279    new_value->type= old_value->type;    new_value->type= old_value->type;
1280    
1281    switch(old_value->type){    switch(old_value->type){
1282      case tfloat:
1283    case integer:    case integer:
1284      new_value->content.val= old_value->content.val;    case func:
1285      case symb:
1286        new_value->content= old_value->content;
1287      break;      break;
1288    case string:    case string:
1289      (char *)(new_value->content.ptr)=      (char *)(new_value->content.ptr)=
1290        strdup((char *)(old_value->content.ptr));        strdup((char *)(old_value->content.ptr));
1291      break;      break;
   case func:  
   case symb:  
     new_value->content.ptr= old_value->content.ptr;  
     break;  
1292    case list:    case list:
1293      new_value->content.ptr= NULL;      new_value->content.ptr= NULL;
1294    
# Line 1098  value *copy_val(environment *env, value Line 1310  value *copy_val(environment *env, value
1310      break;      break;
1311    }    }
1312    
1313    unprotect(env);    unprotect(old_value); unprotect(new_value);
1314    
1315    return new_value;    return new_value;
1316  }  }
1317    
1318  /* "dup"; duplicates an item on the stack */  /* "dup"; duplicates an item on the stack */
1319  extern void sx_647570(environment *env) {  extern void sx_647570(environment *env)
1320    {
1321    if((env->head)==NULL) {    if((env->head)==NULL) {
1322      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1323      env->err= 1;      env->err= 1;
# Line 1114  extern void sx_647570(environment *env) Line 1327  extern void sx_647570(environment *env)
1327  }  }
1328    
1329  /* "if", If-Then */  /* "if", If-Then */
1330  extern void sx_6966(environment *env) {  extern void sx_6966(environment *env)
1331    {
1332    int truth;    int truth;
1333    
1334    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 1346  extern void sx_6966(environment *env) {
1346    swap(env);    swap(env);
1347    if(env->err) return;    if(env->err) return;
1348        
1349    truth=env->head->item->content.val;    truth=env->head->item->content.i;
1350    
1351    toss(env);    toss(env);
1352    if(env->err) return;    if(env->err) return;
# Line 1145  extern void sx_6966(environment *env) { Line 1358  extern void sx_6966(environment *env) {
1358  }  }
1359    
1360  /* If-Then-Else */  /* If-Then-Else */
1361  extern void ifelse(environment *env) {  extern void ifelse(environment *env)
1362    {
1363    int truth;    int truth;
1364    
1365    if((env->head)==NULL || env->head->next==NULL    if((env->head)==NULL || env->head->next==NULL
# Line 1165  extern void ifelse(environment *env) { Line 1378  extern void ifelse(environment *env) {
1378    rot(env);    rot(env);
1379    if(env->err) return;    if(env->err) return;
1380        
1381    truth=env->head->item->content.val;    truth=env->head->item->content.i;
1382    
1383    toss(env);    toss(env);
1384    if(env->err) return;    if(env->err) return;
# Line 1181  extern void ifelse(environment *env) { Line 1394  extern void ifelse(environment *env) {
1394  }  }
1395    
1396  /* "while" */  /* "while" */
1397  extern void sx_7768696c65(environment *env) {  extern void sx_7768696c65(environment *env)
1398    {
1399    int truth;    int truth;
1400    value *loop, *test;    value *loop, *test;
1401    
# Line 1193  extern void sx_7768696c65(environment *e Line 1406  extern void sx_7768696c65(environment *e
1406    }    }
1407    
1408    loop= env->head->item;    loop= env->head->item;
1409    protect(env, loop);    protect(loop);
1410    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1411    
1412    test= env->head->item;    test= env->head->item;
1413    protect(env, test);    protect(test);
1414    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1415    
1416    do {    do {
# Line 1210  extern void sx_7768696c65(environment *e Line 1423  extern void sx_7768696c65(environment *e
1423        return;        return;
1424      }      }
1425            
1426      truth= env->head->item->content.val;      truth= env->head->item->content.i;
1427      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1428            
1429      if(truth) {      if(truth) {
# Line 1222  extern void sx_7768696c65(environment *e Line 1435  extern void sx_7768696c65(environment *e
1435        
1436    } while(truth);    } while(truth);
1437    
1438    unprotect(env); unprotect(env);    unprotect(loop); unprotect(test);
1439  }  }
1440    
1441    
1442  /* "for"; for-loop */  /* "for"; for-loop */
1443  extern void sx_666f72(environment *env) {  extern void sx_666f72(environment *env)
1444    {
1445    value *loop;    value *loop;
1446    int foo1, foo2;    int foo1, foo2;
1447    
# Line 1246  extern void sx_666f72(environment *env) Line 1460  extern void sx_666f72(environment *env)
1460    }    }
1461    
1462    loop= env->head->item;    loop= env->head->item;
1463    protect(env, loop);    protect(loop);
1464    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1465    
1466    foo2= env->head->item->content.val;    foo2= env->head->item->content.i;
1467    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1468    
1469    foo1= env->head->item->content.val;    foo1= env->head->item->content.i;
1470    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1471    
1472    if(foo1<=foo2) {    if(foo1<=foo2) {
# Line 1270  extern void sx_666f72(environment *env) Line 1484  extern void sx_666f72(environment *env)
1484        foo1--;        foo1--;
1485      }      }
1486    }    }
1487    unprotect(env);    unprotect(loop);
1488  }  }
1489    
1490  /* Variant of for-loop */  /* Variant of for-loop */
1491  extern void foreach(environment *env) {  extern void foreach(environment *env)
1492      {  
1493    value *loop, *foo;    value *loop, *foo;
1494    stackitem *iterator;    stackitem *iterator;
1495        
# Line 1292  extern void foreach(environment *env) { Line 1506  extern void foreach(environment *env) {
1506    }    }
1507    
1508    loop= env->head->item;    loop= env->head->item;
1509    protect(env, loop);    protect(loop);
1510    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1511    
1512    foo= env->head->item;    foo= env->head->item;
1513    protect(env, foo);    protect(foo);
1514    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1515    
1516    iterator= foo->content.ptr;    iterator= foo->content.ptr;
# Line 1307  extern void foreach(environment *env) { Line 1521  extern void foreach(environment *env) {
1521      eval(env); if(env->err) return;      eval(env); if(env->err) return;
1522      iterator= iterator->next;      iterator= iterator->next;
1523    }    }
1524    unprotect(env); unprotect(env);    unprotect(loop); unprotect(foo);
1525  }  }
1526    
1527  /* "to" */  /* "to" */
1528  extern void to(environment *env) {  extern void to(environment *env)
1529    int i, start, ending;  {
1530    stackitem *temp_head;    int ending, start, i;
1531    value *temp_val;    stackitem *iterator, *temp;
1532        value *pack;
1533    
1534    if((env->head)==NULL || env->head->next==NULL) {    if((env->head)==NULL || env->head->next==NULL) {
1535      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1536      env->err=1;      env->err=1;
# Line 1329  extern void to(environment *env) { Line 1544  extern void to(environment *env) {
1544      return;      return;
1545    }    }
1546    
1547    ending= env->head->item->content.val;    ending= env->head->item->content.i;
1548    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1549    start= env->head->item->content.val;    start= env->head->item->content.i;
1550    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1551    
1552    temp_head= env->head;    push_sym(env, "[");
   env->head= NULL;  
1553    
1554    if(ending>=start) {    if(ending>=start) {
1555      for(i= ending; i>=start; i--)      for(i= ending; i>=start; i--)
# Line 1345  extern void to(environment *env) { Line 1559  extern void to(environment *env) {
1559        push_int(env, i);        push_int(env, i);
1560    }    }
1561    
1562    temp_val= new_val(env);    iterator= env->head;
1563    temp_val->content.ptr= env->head;    pack= new_val(env);
1564    temp_val->type= list;    protect(pack);
1565    env->head= temp_head;  
1566    push_val(env, temp_val);    if(iterator==NULL
1567         || (iterator->item->type==symb
1568         && ((symbol*)(iterator->item->content.ptr))->id[0]=='[')) {
1569        temp= NULL;
1570        toss(env);
1571      } else {
1572        /* Search for first delimiter */
1573        while(iterator->next!=NULL
1574              && (iterator->next->item->type!=symb
1575              || ((symbol*)(iterator->next->item->content.ptr))->id[0]!='['))
1576          iterator= iterator->next;
1577        
1578        /* Extract list */
1579        temp= env->head;
1580        env->head= iterator->next;
1581        iterator->next= NULL;
1582    
1583        pack->type= list;
1584        pack->content.ptr= temp;
1585        
1586        if(env->head!=NULL)
1587          toss(env);
1588      }
1589    
1590      /* Push list */
1591    
1592      push_val(env, pack);
1593    
1594      unprotect(pack);
1595  }  }
1596    
1597  /* Read a string */  /* Read a string */
1598  extern void readline(environment *env) {  extern void readline(environment *env)
1599    {
1600    char in_string[101];    char in_string[101];
1601    
1602    if(fgets(in_string, 100, env->inputstream)==NULL)    if(fgets(in_string, 100, env->inputstream)==NULL)
# Line 1363  extern void readline(environment *env) { Line 1606  extern void readline(environment *env) {
1606  }  }
1607    
1608  /* "read"; Read a value and place on stack */  /* "read"; Read a value and place on stack */
1609  extern void sx_72656164(environment *env) {  extern void sx_72656164(environment *env)
1610    {
1611    const char symbform[]= "%[a-zA-Z0-9!$%*+./:<=>?@^_~-]%n";    const char symbform[]= "%[a-zA-Z0-9!$%*+./:<=>?@^_~-]%n";
1612    const char strform[]= "\"%[^\"]\"%n";    const char strform[]= "\"%[^\"]\"%n";
1613    const char intform[]= "%i%n";    const char intform[]= "%i%n";
1614      const char fltform[]= "%f%n";
1615    const char blankform[]= "%*[ \t]%n";    const char blankform[]= "%*[ \t]%n";
1616    const char ebrackform[]= "]%n";    const char ebrackform[]= "]%n";
1617    const char semicform[]= ";%n";    const char semicform[]= ";%n";
1618    const char bbrackform[]= "[%n";    const char bbrackform[]= "[%n";
1619    
1620    int itemp, readlength= -1;    int itemp, readlength= -1;
1621      int count= -1;
1622      float ftemp;
1623    static int depth= 0;    static int depth= 0;
1624    char *match;    char *match, *ctemp;
1625    size_t inlength;    size_t inlength;
1626    
1627    if(env->in_string==NULL) {    if(env->in_string==NULL) {
# Line 1397  extern void sx_72656164(environment *env Line 1644  extern void sx_72656164(environment *env
1644    inlength= strlen(env->in_string)+1;    inlength= strlen(env->in_string)+1;
1645    match= malloc(inlength);    match= malloc(inlength);
1646    
1647    if(sscanf(env->in_string, blankform, &readlength)!=EOF    if(sscanf(env->in_string, blankform, &readlength) != EOF
1648       && readlength != -1) {       && readlength != -1) {
1649      ;      ;
1650    } else if(sscanf(env->in_string, intform, &itemp, &readlength) != EOF    } else if(sscanf(env->in_string, fltform, &ftemp, &readlength) != EOF
1651              && readlength != -1) {              && readlength != -1) {
1652      push_int(env, itemp);      if(sscanf(env->in_string, intform, &itemp, &count) != EOF
1653           && count==readlength) {
1654          push_int(env, itemp);
1655        } else {
1656          push_float(env, ftemp);
1657        }
1658    } else if(sscanf(env->in_string, strform, match, &readlength) != EOF    } else if(sscanf(env->in_string, strform, match, &readlength) != EOF
1659              && readlength != -1) {              && readlength != -1) {
1660      push_cstring(env, match);      push_cstring(env, match);
# Line 1424  extern void sx_72656164(environment *env Line 1676  extern void sx_72656164(environment *env
1676      free(env->free_string);      free(env->free_string);
1677      env->in_string = env->free_string = NULL;      env->in_string = env->free_string = NULL;
1678    }    }
1679    if ( env->in_string != NULL) {    if (env->in_string != NULL) {
1680      env->in_string += readlength;      env->in_string += readlength;
1681    }    }
1682    
# Line 1434  extern void sx_72656164(environment *env Line 1686  extern void sx_72656164(environment *env
1686      return sx_72656164(env);      return sx_72656164(env);
1687  }  }
1688    
1689  extern void beep(environment *env) {  extern void beep(environment *env)
1690    {
1691    int freq, dur, period, ticks;    int freq, dur, period, ticks;
1692    
1693    if((env->head)==NULL || env->head->next==NULL) {    if((env->head)==NULL || env->head->next==NULL) {
# Line 1451  extern void beep(environment *env) { Line 1703  extern void beep(environment *env) {
1703      return;      return;
1704    }    }
1705    
1706    dur=env->head->item->content.val;    dur=env->head->item->content.i;
1707    toss(env);    toss(env);
1708    freq=env->head->item->content.val;    freq=env->head->item->content.i;
1709    toss(env);    toss(env);
1710    
1711    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 1727  extern void beep(environment *env) {
1727    default:    default:
1728      abort();      abort();
1729    }    }
1730  };  }
1731    
1732  /* "wait" */  /* "wait" */
1733  extern void sx_77616974(environment *env) {  extern void sx_77616974(environment *env)
1734    {
1735    int dur;    int dur;
1736    
1737    if((env->head)==NULL) {    if((env->head)==NULL) {
# Line 1494  extern void sx_77616974(environment *env Line 1746  extern void sx_77616974(environment *env
1746      return;      return;
1747    }    }
1748    
1749    dur=env->head->item->content.val;    dur=env->head->item->content.i;
1750    toss(env);    toss(env);
1751    
1752    usleep(dur);    usleep(dur);
1753  };  }
1754    
1755  extern void copying(environment *env){  extern void copying(environment *env)
1756    {
1757    printf("GNU GENERAL PUBLIC LICENSE\n\    printf("GNU GENERAL PUBLIC LICENSE\n\
1758                         Version 2, June 1991\n\                         Version 2, June 1991\n\
1759  \n\  \n\
# Line 1759  of preserving the free status of all der Line 2012  of preserving the free status of all der
2012  of promoting the sharing and reuse of software generally.\n");  of promoting the sharing and reuse of software generally.\n");
2013  }  }
2014    
2015  extern void warranty(environment *env){  extern void warranty(environment *env)
2016    {
2017    printf("                          NO WARRANTY\n\    printf("                          NO WARRANTY\n\
2018  \n\  \n\
2019    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 2041  POSSIBILITY OF SUCH DAMAGES.\n");
2041  extern void sx_2a(environment *env)  extern void sx_2a(environment *env)
2042  {  {
2043    int a, b;    int a, b;
2044      float fa, fb;
2045    
2046    if((env->head)==NULL || env->head->next==NULL) {    if((env->head)==NULL || env->head->next==NULL) {
2047      printerr("Too Few Arguments");      printerr("Too Few Arguments");
# Line 1794  extern void sx_2a(environment *env) Line 2049  extern void sx_2a(environment *env)
2049      return;      return;
2050    }    }
2051        
2052    if(env->head->item->type!=integer    if(env->head->item->type==integer
2053       || env->head->next->item->type!=integer) {       && env->head->next->item->type==integer) {
2054      printerr("Bad Argument Type");      a=env->head->item->content.i;
2055      env->err=2;      toss(env); if(env->err) return;
2056        b=env->head->item->content.i;
2057        toss(env); if(env->err) return;
2058        push_int(env, b*a);
2059    
2060      return;      return;
2061    }    }
2062    
2063    a=env->head->item->content.val;    if(env->head->item->type==tfloat
2064    toss(env); if(env->err) return;       && env->head->next->item->type==tfloat) {
2065    b=env->head->item->content.val;      fa= env->head->item->content.f;
2066    toss(env); if(env->err) return;      toss(env); if(env->err) return;
2067    push_int(env, b*a);      fb= env->head->item->content.f;
2068        toss(env); if(env->err) return;
2069        push_float(env, fb*fa);
2070        
2071        return;
2072      }
2073    
2074      if(env->head->item->type==tfloat
2075         && env->head->next->item->type==integer) {
2076        fa= env->head->item->content.f;
2077        toss(env); if(env->err) return;
2078        b= env->head->item->content.i;
2079        toss(env); if(env->err) return;
2080        push_float(env, b*fa);
2081        
2082        return;
2083      }
2084    
2085      if(env->head->item->type==integer
2086         && env->head->next->item->type==tfloat) {
2087        a= env->head->item->content.i;
2088        toss(env); if(env->err) return;
2089        fb= env->head->item->content.f;
2090        toss(env); if(env->err) return;
2091        push_float(env, fb*a);
2092    
2093        return;
2094      }
2095    
2096      printerr("Bad Argument Type");
2097      env->err=2;
2098  }  }
2099    
2100  /* "/" */  /* "/" */
2101  extern void sx_2f(environment *env)  extern void sx_2f(environment *env)
2102  {  {
2103    int a, b;    int a, b;
2104      float fa, fb;
2105    
2106    if((env->head)==NULL || env->head->next==NULL) {    if((env->head)==NULL || env->head->next==NULL) {
2107      printerr("Too Few Arguments");      printerr("Too Few Arguments");
# Line 1819  extern void sx_2f(environment *env) Line 2109  extern void sx_2f(environment *env)
2109      return;      return;
2110    }    }
2111        
2112    if(env->head->item->type!=integer    if(env->head->item->type==integer
2113       || env->head->next->item->type!=integer) {       && env->head->next->item->type==integer) {
2114      printerr("Bad Argument Type");      a=env->head->item->content.i;
2115      env->err=2;      toss(env); if(env->err) return;
2116        b=env->head->item->content.i;
2117        toss(env); if(env->err) return;
2118        push_float(env, b/a);
2119    
2120      return;      return;
2121    }    }
2122    
2123    a=env->head->item->content.val;    if(env->head->item->type==tfloat
2124    toss(env); if(env->err) return;       && env->head->next->item->type==tfloat) {
2125    b=env->head->item->content.val;      fa= env->head->item->content.f;
2126    toss(env); if(env->err) return;      toss(env); if(env->err) return;
2127    push_int(env, b/a);      fb= env->head->item->content.f;
2128        toss(env); if(env->err) return;
2129        push_float(env, fb/fa);
2130        
2131        return;
2132      }
2133    
2134      if(env->head->item->type==tfloat
2135         && env->head->next->item->type==integer) {
2136        fa= env->head->item->content.f;
2137        toss(env); if(env->err) return;
2138        b= env->head->item->content.i;
2139        toss(env); if(env->err) return;
2140        push_float(env, b/fa);
2141        
2142        return;
2143      }
2144    
2145      if(env->head->item->type==integer
2146         && env->head->next->item->type==tfloat) {
2147        a= env->head->item->content.i;
2148        toss(env); if(env->err) return;
2149        fb= env->head->item->content.f;
2150        toss(env); if(env->err) return;
2151        push_float(env, fb/a);
2152    
2153        return;
2154      }
2155    
2156      printerr("Bad Argument Type");
2157      env->err=2;
2158  }  }
2159    
2160  /* "mod" */  /* "mod" */
# Line 1840  extern void mod(environment *env) Line 2164  extern void mod(environment *env)
2164    
2165    if((env->head)==NULL || env->head->next==NULL) {    if((env->head)==NULL || env->head->next==NULL) {
2166      printerr("Too Few Arguments");      printerr("Too Few Arguments");
2167      env->err=1;      env->err= 1;
2168      return;      return;
2169    }    }
2170        
2171    if(env->head->item->type!=integer    if(env->head->item->type==integer
2172       || env->head->next->item->type!=integer) {       && env->head->next->item->type==integer) {
2173      printerr("Bad Argument Type");      a= env->head->item->content.i;
2174      env->err=2;      toss(env); if(env->err) return;
2175        b= env->head->item->content.i;
2176        toss(env); if(env->err) return;
2177        push_int(env, b%a);
2178    
2179      return;      return;
2180    }    }
2181    
2182    a=env->head->item->content.val;    printerr("Bad Argument Type");
2183    toss(env); if(env->err) return;    env->err=2;
2184    b=env->head->item->content.val;  }
2185    toss(env); if(env->err) return;  
2186    push_int(env, b%a);  /* "div" */
2187    extern void sx_646976(environment *env)
2188    {
2189      int a, b;
2190      
2191      if((env->head)==NULL || env->head->next==NULL) {
2192        printerr("Too Few Arguments");
2193        env->err= 1;
2194        return;
2195      }
2196    
2197      if(env->head->item->type==integer
2198         && env->head->next->item->type==integer) {
2199        a= env->head->item->content.i;
2200        toss(env); if(env->err) return;
2201        b= env->head->item->content.i;
2202        toss(env); if(env->err) return;
2203        push_int(env, (int)b/a);
2204    
2205        return;
2206      }
2207    
2208      printerr("Bad Argument Type");
2209      env->err= 2;
2210  }  }
Legend:
Removed from v.1.92  
changed lines
  Added in v.1.100
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26