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

Diff of /stack/stack.c

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

revision 1.91 by teddy, Thu Mar 7 03:28:29 2002 UTC revision 1.101 by teddy, Sun Mar 10 13:00:01 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.");
   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);
223        env->gc_ref->next= new_head;        if(env->gc_ref->item->type == string)
224        new_head= env->gc_ref;          env->gc_count += strlen(env->gc_ref->item->content.ptr);
       env->gc_ref= titem;  
       env->gc_count++;  
225      }      }
226        
227        /* Keep values */
228        titem= env->gc_ref->next;
229        env->gc_ref->next= new_head;
230        new_head= env->gc_ref;
231        new_head->item->gc.flag.mark= 0;
232        env->gc_ref= titem;
233    }    }
234    
235    env->gc_limit= env->gc_count*2;    if (env->gc_limit < env->gc_count*2)
236        env->gc_limit= env->gc_count*2;
237    
238    env->gc_ref= new_head;    env->gc_ref= new_head;
239    
240      if(env->interactive){
241        printf("done\n");
242      }
243    
244  }  }
245    
246  void protect(environment *env, value *val)  /* Protect values from GC */
247    void protect(value *val)
248  {  {
249    stackitem *new_item= malloc(sizeof(stackitem));    stackitem *iterator;
250    new_item->item= val;  
251    new_item->next= env->gc_protect;    if(val->gc.flag.protect)
252    env->gc_protect= new_item;      return;
253    
254      val->gc.flag.protect= 1;
255    
256      if(val->type==list) {
257        iterator= val->content.ptr;
258    
259        while(iterator!=NULL) {
260          protect(iterator->item);
261          iterator= iterator->next;
262        }
263      }
264  }  }
265    
266  void unprotect(environment *env)  /* Unprotect values from GC */
267    void unprotect(value *val)
268  {  {
269    stackitem *temp= env->gc_protect;    stackitem *iterator;
270    env->gc_protect= env->gc_protect->next;  
271    free(temp);    if(!(val->gc.flag.protect))
272        return;
273    
274      val->gc.flag.protect= 0;
275    
276      if(val->type==list) {
277        iterator= val->content.ptr;
278    
279        while(iterator!=NULL) {
280          unprotect(iterator->item);
281          iterator= iterator->next;
282        }
283      }
284  }  }
285    
286  /* Push a value onto the stack */  /* Push a value onto the stack */
# Line 247  void push_val(environment *env, value *v Line 292  void push_val(environment *env, value *v
292    env->head= new_item;    env->head= new_item;
293  }  }
294    
295  /* Push an integer onto the stack. */  /* Push an integer onto the stack */
296  void push_int(environment *env, int in_val)  void push_int(environment *env, int in_val)
297  {  {
298    value *new_value= new_val(env);    value *new_value= new_val(env);
299        
300    new_value->content.val= in_val;    new_value->content.i= in_val;
301    new_value->type= integer;    new_value->type= integer;
302    
303    push_val(env, new_value);    push_val(env, new_value);
304  }  }
305    
306    /* Push a floating point number onto the stack */
307    void push_float(environment *env, float in_val)
308    {
309      value *new_value= new_val(env);
310    
311      new_value->content.f= in_val;
312      new_value->type= tfloat;
313    
314      push_val(env, new_value);
315    }
316    
317  /* Copy a string onto the stack. */  /* Copy a string onto the stack. */
318  void push_cstring(environment *env, const char *in_string)  void push_cstring(environment *env, const char *in_string)
319  {  {
320    value *new_value= new_val(env);    value *new_value= new_val(env);
321      int length= strlen(in_string)+1;
322    
323    new_value->content.ptr= malloc(strlen(in_string)+1);    new_value->content.ptr= malloc(length);
324      env->gc_count += length;
325    strcpy(new_value->content.ptr, in_string);    strcpy(new_value->content.ptr, in_string);
326    new_value->type= string;    new_value->type= string;
327    
# Line 271  void push_cstring(environment *env, cons Line 329  void push_cstring(environment *env, cons
329  }  }
330    
331  /* Mangle a symbol name to a valid C identifier name */  /* Mangle a symbol name to a valid C identifier name */
332  char *mangle_str(const char *old_string){  char *mangle_str(const char *old_string)
333    {
334    char validchars[]= "0123456789abcdef";    char validchars[]= "0123456789abcdef";
335    char *new_string, *current;    char *new_string, *current;
336    
# Line 289  char *mangle_str(const char *old_string) Line 348  char *mangle_str(const char *old_string)
348    return new_string;            /* The caller must free() it */    return new_string;            /* The caller must free() it */
349  }  }
350    
351  extern void mangle(environment *env){  extern void mangle(environment *env)
352    {
353    char *new_string;    char *new_string;
354    
355    if((env->head)==NULL) {    if((env->head)==NULL) {
# Line 328  void push_sym(environment *env, const ch Line 388  void push_sym(environment *env, const ch
388    char *mangled;                /* Mangled function name */    char *mangled;                /* Mangled function name */
389    
390    new_value= new_val(env);    new_value= new_val(env);
391      protect(new_value);
392      new_fvalue= new_val(env);
393      protect(new_fvalue);
394    
395    /* The new value is a symbol */    /* The new value is a symbol */
396    new_value->type= symb;    new_value->type= symb;
# Line 355  void push_sym(environment *env, const ch Line 418  void push_sym(environment *env, const ch
418    
419      mangled= mangle_str(in_string); /* mangle the name */      mangled= mangle_str(in_string); /* mangle the name */
420      funcptr= dlsym(handle, mangled); /* and try to find it */      funcptr= dlsym(handle, mangled); /* and try to find it */
421      free(mangled);  
422      dlerr= dlerror();      dlerr= dlerror();
423      if(dlerr != NULL) {         /* If no function was found */      if(dlerr != NULL) {         /* If no function was found */
424        funcptr= dlsym(handle, in_string); /* Get function pointer */        funcptr= dlsym(handle, in_string); /* Get function pointer */
425        dlerr= dlerror();        dlerr= dlerror();
426      }      }
427    
428      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 */  
429        new_fvalue->type= func;   /* The new value is a function pointer */        new_fvalue->type= func;   /* The new value is a function pointer */
430        new_fvalue->content.ptr= funcptr; /* Store function pointer */        new_fvalue->content.ptr= funcptr; /* Store function pointer */
431        (*new_symbol)->val= new_fvalue; /* Bind the symbol to the new        (*new_symbol)->val= new_fvalue; /* Bind the symbol to the new
432                                           function value */                                           function value */
433      }      }
434    
435        free(mangled);
436    }    }
437    
438    push_val(env, new_value);    push_val(env, new_value);
439      unprotect(new_value); unprotect(new_fvalue);
440  }  }
441    
442  /* Print newline. */  /* Print newline. */
# Line 379  extern void nl() Line 446  extern void nl()
446  }  }
447    
448  /* Gets the type of a value */  /* Gets the type of a value */
449  extern void type(environment *env){  extern void type(environment *env)
450    {
451    int typenum;    int typenum;
452    
453    if((env->head)==NULL) {    if((env->head)==NULL) {
# Line 393  extern void type(environment *env){ Line 461  extern void type(environment *env){
461    case integer:    case integer:
462      push_sym(env, "integer");      push_sym(env, "integer");
463      break;      break;
464      case tfloat:
465        push_sym(env, "float");
466        break;
467    case string:    case string:
468      push_sym(env, "string");      push_sym(env, "string");
469      break;      break;
# Line 413  void print_h(stackitem *stack_head, int Line 484  void print_h(stackitem *stack_head, int
484  {  {
485    switch(stack_head->item->type) {    switch(stack_head->item->type) {
486    case integer:    case integer:
487      printf("%d", stack_head->item->content.val);      printf("%d", stack_head->item->content.i);
488        break;
489      case tfloat:
490        printf("%f", stack_head->item->content.f);
491      break;      break;
492    case string:    case string:
493      if(noquote)      if(noquote)
# Line 441  void print_h(stackitem *stack_head, int Line 515  void print_h(stackitem *stack_head, int
515    }    }
516  }  }
517    
518  extern void print_(environment *env) {  extern void print_(environment *env)
519    {
520    if(env->head==NULL) {    if(env->head==NULL) {
521      printerr("Too Few Arguments");      printerr("Too Few Arguments");
522      env->err=1;      env->err=1;
# Line 459  extern void print(environment *env) Line 534  extern void print(environment *env)
534    toss(env);    toss(env);
535  }  }
536    
537  extern void princ_(environment *env) {  extern void princ_(environment *env)
538    {
539    if(env->head==NULL) {    if(env->head==NULL) {
540      printerr("Too Few Arguments");      printerr("Too Few Arguments");
541      env->err=1;      env->err=1;
# Line 493  extern void printstack(environment *env) Line 569  extern void printstack(environment *env)
569      printf("Stack Empty\n");      printf("Stack Empty\n");
570      return;      return;
571    }    }
572    
573    print_st(env->head, 1);    print_st(env->head, 1);
574  }  }
575    
# Line 552  extern void rcl(environment *env) Line 629  extern void rcl(environment *env)
629      env->err=3;      env->err=3;
630      return;      return;
631    }    }
632    protect(env, val);    protect(val);
633    toss(env);            /* toss the symbol */    toss(env);            /* toss the symbol */
634    if(env->err) return;    if(env->err) return;
635    push_val(env, val); /* Return its bound value */    push_val(env, val); /* Return its bound value */
636    unprotect(env);    unprotect(val);
637  }  }
638    
639  /* 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 647  extern void eval(environment *env)
647    
648   eval_start:   eval_start:
649    
650      gc_maybe(env);
651    
652    if(env->head==NULL) {    if(env->head==NULL) {
653      printerr("Too Few Arguments");      printerr("Too Few Arguments");
654      env->err=1;      env->err=1;
# Line 596  extern void eval(environment *env) Line 675  extern void eval(environment *env)
675      /* If it's a list */      /* If it's a list */
676    case list:    case list:
677      temp_val= env->head->item;      temp_val= env->head->item;
678      protect(env, temp_val);      protect(temp_val);
679      toss(env);  
680      if(env->err) return;      toss(env); if(env->err) return;
681      iterator= (stackitem*)temp_val->content.ptr;      iterator= (stackitem*)temp_val->content.ptr;
     unprotect(env);  
682            
683      while(iterator!=NULL) {      while(iterator!=NULL) {
684        push_val(env, iterator->item);        push_val(env, iterator->item);
685                
686        if(env->head->item->type==symb        if(env->head->item->type==symb
687          && strcmp(";", ((symbol*)(env->head->item->content.ptr))->id)==0) {           && (((symbol*)(env->head->item->content.ptr))->id[0] == ';')) {
688          toss(env);          toss(env);
689          if(env->err) return;          if(env->err) return;
690                    
# Line 618  extern void eval(environment *env) Line 696  extern void eval(environment *env)
696        }        }
697        iterator= iterator->next;        iterator= iterator->next;
698      }      }
699        unprotect(temp_val);
700      return;      return;
701    
702    default:    default:
# Line 626  extern void eval(environment *env) Line 705  extern void eval(environment *env)
705  }  }
706    
707  /* Reverse (flip) a list */  /* Reverse (flip) a list */
708  extern void rev(environment *env){  extern void rev(environment *env)
709    {
710    stackitem *old_head, *new_head, *item;    stackitem *old_head, *new_head, *item;
711    
712    if((env->head)==NULL) {    if((env->head)==NULL) {
# Line 659  extern void pack(environment *env) Line 739  extern void pack(environment *env)
739    value *pack;    value *pack;
740    
741    iterator= env->head;    iterator= env->head;
742      pack= new_val(env);
743      protect(pack);
744    
745    if(iterator==NULL    if(iterator==NULL
746       || (iterator->item->type==symb       || (iterator->item->type==symb
# Line 676  extern void pack(environment *env) Line 758  extern void pack(environment *env)
758      temp= env->head;      temp= env->head;
759      env->head= iterator->next;      env->head= iterator->next;
760      iterator->next= NULL;      iterator->next= NULL;
761    
762        pack->type= list;
763        pack->content.ptr= temp;
764            
765      if(env->head!=NULL)      if(env->head!=NULL)
766        toss(env);        toss(env);
767    }    }
768    
769    /* Push list */    /* Push list */
   pack= new_val(env);  
   pack->type= list;  
   pack->content.ptr= temp;  
770    
771    push_val(env, pack);    push_val(env, pack);
772    rev(env);    rev(env);
773    
774      unprotect(pack);
775  }  }
776    
777  /* Relocate elements of the list on the stack. */  /* Relocate elements of the list on the stack. */
# Line 765  extern void not(environment *env) Line 849  extern void not(environment *env)
849      return;      return;
850    }    }
851    
852    val= env->head->item->content.val;    val= env->head->item->content.i;
853    toss(env);    toss(env);
854    push_int(env, !val);    push_int(env, !val);
855  }  }
# Line 808  extern void def(environment *env) Line 892  extern void def(environment *env)
892  /* Quit stack. */  /* Quit stack. */
893  extern void quit(environment *env)  extern void quit(environment *env)
894  {  {
895    long i;    int i;
896    
897    clear(env);    clear(env);
898    
# Line 821  extern void quit(environment *env) Line 905  extern void quit(environment *env)
905    }    }
906    
907    env->gc_limit= 0;    env->gc_limit= 0;
908    gc_init(env);    gc_maybe(env);
909    
910    if(env->free_string!=NULL)    if(env->free_string!=NULL)
911      free(env->free_string);      free(env->free_string);
# Line 854  extern void words(environment *env) Line 938  extern void words(environment *env)
938  }  }
939    
940  /* Internal forget function */  /* Internal forget function */
941  void forget_sym(symbol **hash_entry) {  void forget_sym(symbol **hash_entry)
942    {
943    symbol *temp;    symbol *temp;
944    
945    temp= *hash_entry;    temp= *hash_entry;
# Line 889  extern void forget(environment *env) Line 974  extern void forget(environment *env)
974  }  }
975    
976  /* Returns the current error number to the stack */  /* Returns the current error number to the stack */
977  extern void errn(environment *env){  extern void errn(environment *env)
978    {
979    push_int(env, env->err);    push_int(env, env->err);
980  }  }
981    
# Line 958  under certain conditions; type `copying; Line 1044  under certain conditions; type `copying;
1044        toss(&myenv);             /* No error check in main */        toss(&myenv);             /* No error check in main */
1045        eval(&myenv);        eval(&myenv);
1046      }      }
1047      gc_init(&myenv);      gc_maybe(&myenv);
1048    }    }
1049    quit(&myenv);    quit(&myenv);
1050    return EXIT_FAILURE;    return EXIT_FAILURE;
1051  }  }
1052    
1053  /* "+" */  /* "+" */
1054  extern void sx_2b(environment *env) {  extern void sx_2b(environment *env)
1055    {
1056    int a, b;    int a, b;
1057      float fa, fb;
1058    size_t len;    size_t len;
1059    char* new_string;    char* new_string;
1060    value *a_val, *b_val;    value *a_val, *b_val;
# Line 981  extern void sx_2b(environment *env) { Line 1069  extern void sx_2b(environment *env) {
1069       && env->head->next->item->type==string) {       && env->head->next->item->type==string) {
1070      a_val= env->head->item;      a_val= env->head->item;
1071      b_val= env->head->next->item;      b_val= env->head->next->item;
1072      protect(env, a_val); protect(env, b_val);      protect(a_val); protect(b_val);
1073      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1074      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1075      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 1077  extern void sx_2b(environment *env) {
1077      strcpy(new_string, b_val->content.ptr);      strcpy(new_string, b_val->content.ptr);
1078      strcat(new_string, a_val->content.ptr);      strcat(new_string, a_val->content.ptr);
1079      push_cstring(env, new_string);      push_cstring(env, new_string);
1080      unprotect(env); unprotect(env);      unprotect(a_val); unprotect(b_val);
1081      free(new_string);      free(new_string);
1082        
1083      return;      return;
1084    }    }
1085        
1086    if(env->head->item->type!=integer    if(env->head->item->type==integer
1087       || env->head->next->item->type!=integer) {       && env->head->next->item->type==integer) {
1088      printerr("Bad Argument Type");      a=env->head->item->content.i;
1089      env->err=2;      toss(env); if(env->err) return;
1090        b=env->head->item->content.i;
1091        toss(env); if(env->err) return;
1092        push_int(env, b+a);
1093    
1094      return;      return;
1095    }    }
1096    a= env->head->item->content.val;  
1097    toss(env); if(env->err) return;    if(env->head->item->type==tfloat
1098           && env->head->next->item->type==tfloat) {
1099    b= env->head->item->content.val;      fa= env->head->item->content.f;
1100    toss(env); if(env->err) return;      toss(env); if(env->err) return;
1101    push_int(env, a+b);      fb= env->head->item->content.f;
1102        toss(env); if(env->err) return;
1103        push_float(env, fb+fa);
1104        
1105        return;
1106      }
1107    
1108      if(env->head->item->type==tfloat
1109         && env->head->next->item->type==integer) {
1110        fa= env->head->item->content.f;
1111        toss(env); if(env->err) return;
1112        b= env->head->item->content.i;
1113        toss(env); if(env->err) return;
1114        push_float(env, b+fa);
1115        
1116        return;
1117      }
1118    
1119      if(env->head->item->type==integer
1120         && env->head->next->item->type==tfloat) {
1121        a= env->head->item->content.i;
1122        toss(env); if(env->err) return;
1123        fb= env->head->item->content.f;
1124        toss(env); if(env->err) return;
1125        push_float(env, fb+a);
1126    
1127        return;
1128      }
1129    
1130      printerr("Bad Argument Type");
1131      env->err=2;
1132  }  }
1133    
1134  /* "-" */  /* "-" */
1135  extern void sx_2d(environment *env) {  extern void sx_2d(environment *env)
1136    {
1137    int a, b;    int a, b;
1138      float fa, fb;
1139    
1140    if((env->head)==NULL || env->head->next==NULL) {    if((env->head)==NULL || env->head->next==NULL) {
1141      printerr("Too Few Arguments");      printerr("Too Few Arguments");
# Line 1018  extern void sx_2d(environment *env) { Line 1143  extern void sx_2d(environment *env) {
1143      return;      return;
1144    }    }
1145        
1146    if(env->head->item->type!=integer    if(env->head->item->type==integer
1147       || env->head->next->item->type!=integer) {       && env->head->next->item->type==integer) {
1148      printerr("Bad Argument Type");      a=env->head->item->content.i;
1149      env->err=2;      toss(env); if(env->err) return;
1150        b=env->head->item->content.i;
1151        toss(env); if(env->err) return;
1152        push_int(env, b-a);
1153    
1154      return;      return;
1155    }    }
1156    
1157    a=env->head->item->content.val;    if(env->head->item->type==tfloat
1158    toss(env); if(env->err) return;       && env->head->next->item->type==tfloat) {
1159    b=env->head->item->content.val;      fa= env->head->item->content.f;
1160    toss(env); if(env->err) return;      toss(env); if(env->err) return;
1161    push_int(env, b-a);      fb= env->head->item->content.f;
1162        toss(env); if(env->err) return;
1163        push_float(env, fb-fa);
1164        
1165        return;
1166      }
1167    
1168      if(env->head->item->type==tfloat
1169         && env->head->next->item->type==integer) {
1170        fa= env->head->item->content.f;
1171        toss(env); if(env->err) return;
1172        b= env->head->item->content.i;
1173        toss(env); if(env->err) return;
1174        push_float(env, b-fa);
1175        
1176        return;
1177      }
1178    
1179      if(env->head->item->type==integer
1180         && env->head->next->item->type==tfloat) {
1181        a= env->head->item->content.i;
1182        toss(env); if(env->err) return;
1183        fb= env->head->item->content.f;
1184        toss(env); if(env->err) return;
1185        push_float(env, fb-a);
1186    
1187        return;
1188      }
1189    
1190      printerr("Bad Argument Type");
1191      env->err=2;
1192  }  }
1193    
1194  /* ">" */  /* ">" */
1195  extern void sx_3e(environment *env) {  extern void sx_3e(environment *env)
1196    {
1197    int a, b;    int a, b;
1198      float fa, fb;
1199    
1200    if((env->head)==NULL || env->head->next==NULL) {    if((env->head)==NULL || env->head->next==NULL) {
1201      printerr("Too Few Arguments");      printerr("Too Few Arguments");
# Line 1042  extern void sx_3e(environment *env) { Line 1203  extern void sx_3e(environment *env) {
1203      return;      return;
1204    }    }
1205        
1206    if(env->head->item->type!=integer    if(env->head->item->type==integer
1207       || env->head->next->item->type!=integer) {       && env->head->next->item->type==integer) {
1208      printerr("Bad Argument Type");      a=env->head->item->content.i;
1209      env->err=2;      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>a);
1213    
1214      return;      return;
1215    }    }
1216    
1217    a=env->head->item->content.val;    if(env->head->item->type==tfloat
1218    toss(env); if(env->err) return;       && env->head->next->item->type==tfloat) {
1219    b=env->head->item->content.val;      fa= env->head->item->content.f;
1220    toss(env); if(env->err) return;      toss(env); if(env->err) return;
1221    push_int(env, b>a);      fb= env->head->item->content.f;
1222        toss(env); if(env->err) return;
1223        push_int(env, fb>fa);
1224        
1225        return;
1226      }
1227    
1228      if(env->head->item->type==tfloat
1229         && env->head->next->item->type==integer) {
1230        fa= env->head->item->content.f;
1231        toss(env); if(env->err) return;
1232        b= env->head->item->content.i;
1233        toss(env); if(env->err) return;
1234        push_int(env, b>fa);
1235        
1236        return;
1237      }
1238    
1239      if(env->head->item->type==integer
1240         && env->head->next->item->type==tfloat) {
1241        a= env->head->item->content.i;
1242        toss(env); if(env->err) return;
1243        fb= env->head->item->content.f;
1244        toss(env); if(env->err) return;
1245        push_int(env, fb>a);
1246    
1247        return;
1248      }
1249    
1250      printerr("Bad Argument Type");
1251      env->err=2;
1252    }
1253    
1254    /* "<" */
1255    extern void sx_3c(environment *env)
1256    {
1257      swap(env); if(env->err) return;
1258      sx_3e(env);
1259    }
1260    
1261    /* "<=" */
1262    extern void sx_3c3d(environment *env)
1263    {
1264      sx_3e(env); if(env->err) return;
1265      not(env);
1266    }
1267    
1268    /* ">=" */
1269    extern void sx_3e3d(environment *env)
1270    {
1271      sx_3c(env); if(env->err) return;
1272      not(env);
1273  }  }
1274    
1275  /* Return copy of a value */  /* Return copy of a value */
1276  value *copy_val(environment *env, value *old_value){  value *copy_val(environment *env, value *old_value)
1277    {
1278    stackitem *old_item, *new_item, *prev_item;    stackitem *old_item, *new_item, *prev_item;
1279      value *new_value;
1280    
1281    value *new_value= new_val(env);    protect(old_value);
1282      new_value= new_val(env);
1283    protect(env, old_value);    protect(new_value);
1284    new_value->type= old_value->type;    new_value->type= old_value->type;
1285    
1286    switch(old_value->type){    switch(old_value->type){
1287      case tfloat:
1288    case integer:    case integer:
1289      new_value->content.val= old_value->content.val;    case func:
1290      case symb:
1291        new_value->content= old_value->content;
1292      break;      break;
1293    case string:    case string:
1294      (char *)(new_value->content.ptr)=      (char *)(new_value->content.ptr)=
1295        strdup((char *)(old_value->content.ptr));        strdup((char *)(old_value->content.ptr));
1296      break;      break;
   case func:  
   case symb:  
     new_value->content.ptr= old_value->content.ptr;  
     break;  
1297    case list:    case list:
1298      new_value->content.ptr= NULL;      new_value->content.ptr= NULL;
1299    
# Line 1098  value *copy_val(environment *env, value Line 1315  value *copy_val(environment *env, value
1315      break;      break;
1316    }    }
1317    
1318    unprotect(env);    unprotect(old_value); unprotect(new_value);
1319    
1320    return new_value;    return new_value;
1321  }  }
1322    
1323  /* "dup"; duplicates an item on the stack */  /* "dup"; duplicates an item on the stack */
1324  extern void sx_647570(environment *env) {  extern void sx_647570(environment *env)
1325    {
1326    if((env->head)==NULL) {    if((env->head)==NULL) {
1327      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1328      env->err= 1;      env->err= 1;
# Line 1114  extern void sx_647570(environment *env) Line 1332  extern void sx_647570(environment *env)
1332  }  }
1333    
1334  /* "if", If-Then */  /* "if", If-Then */
1335  extern void sx_6966(environment *env) {  extern void sx_6966(environment *env)
1336    {
1337    int truth;    int truth;
1338    
1339    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 1351  extern void sx_6966(environment *env) {
1351    swap(env);    swap(env);
1352    if(env->err) return;    if(env->err) return;
1353        
1354    truth=env->head->item->content.val;    truth=env->head->item->content.i;
1355    
1356    toss(env);    toss(env);
1357    if(env->err) return;    if(env->err) return;
# Line 1145  extern void sx_6966(environment *env) { Line 1363  extern void sx_6966(environment *env) {
1363  }  }
1364    
1365  /* If-Then-Else */  /* If-Then-Else */
1366  extern void ifelse(environment *env) {  extern void ifelse(environment *env)
1367    {
1368    int truth;    int truth;
1369    
1370    if((env->head)==NULL || env->head->next==NULL    if((env->head)==NULL || env->head->next==NULL
# Line 1165  extern void ifelse(environment *env) { Line 1383  extern void ifelse(environment *env) {
1383    rot(env);    rot(env);
1384    if(env->err) return;    if(env->err) return;
1385        
1386    truth=env->head->item->content.val;    truth=env->head->item->content.i;
1387    
1388    toss(env);    toss(env);
1389    if(env->err) return;    if(env->err) return;
# Line 1181  extern void ifelse(environment *env) { Line 1399  extern void ifelse(environment *env) {
1399  }  }
1400    
1401  /* "while" */  /* "while" */
1402  extern void sx_7768696c65(environment *env) {  extern void sx_7768696c65(environment *env)
1403    {
1404    int truth;    int truth;
1405    value *loop, *test;    value *loop, *test;
1406    
# Line 1193  extern void sx_7768696c65(environment *e Line 1411  extern void sx_7768696c65(environment *e
1411    }    }
1412    
1413    loop= env->head->item;    loop= env->head->item;
1414    protect(env, loop);    protect(loop);
1415    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1416    
1417    test= env->head->item;    test= env->head->item;
1418    protect(env, test);    protect(test);
1419    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1420    
1421    do {    do {
# Line 1210  extern void sx_7768696c65(environment *e Line 1428  extern void sx_7768696c65(environment *e
1428        return;        return;
1429      }      }
1430            
1431      truth= env->head->item->content.val;      truth= env->head->item->content.i;
1432      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1433            
1434      if(truth) {      if(truth) {
# Line 1222  extern void sx_7768696c65(environment *e Line 1440  extern void sx_7768696c65(environment *e
1440        
1441    } while(truth);    } while(truth);
1442    
1443    unprotect(env); unprotect(env);    unprotect(loop); unprotect(test);
1444  }  }
1445    
1446    
1447  /* "for"; for-loop */  /* "for"; for-loop */
1448  extern void sx_666f72(environment *env) {  extern void sx_666f72(environment *env)
1449    {
1450    value *loop;    value *loop;
1451    int foo1, foo2;    int foo1, foo2;
1452    
# Line 1246  extern void sx_666f72(environment *env) Line 1465  extern void sx_666f72(environment *env)
1465    }    }
1466    
1467    loop= env->head->item;    loop= env->head->item;
1468    protect(env, loop);    protect(loop);
1469    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1470    
1471    foo2= env->head->item->content.val;    foo2= env->head->item->content.i;
1472    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1473    
1474    foo1= env->head->item->content.val;    foo1= env->head->item->content.i;
1475    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1476    
1477    if(foo1<=foo2) {    if(foo1<=foo2) {
# Line 1270  extern void sx_666f72(environment *env) Line 1489  extern void sx_666f72(environment *env)
1489        foo1--;        foo1--;
1490      }      }
1491    }    }
1492    unprotect(env);    unprotect(loop);
1493  }  }
1494    
1495  /* Variant of for-loop */  /* Variant of for-loop */
1496  extern void foreach(environment *env) {  extern void foreach(environment *env)
1497      {  
1498    value *loop, *foo;    value *loop, *foo;
1499    stackitem *iterator;    stackitem *iterator;
1500        
# Line 1292  extern void foreach(environment *env) { Line 1511  extern void foreach(environment *env) {
1511    }    }
1512    
1513    loop= env->head->item;    loop= env->head->item;
1514    protect(env, loop);    protect(loop);
1515    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1516    
1517    foo= env->head->item;    foo= env->head->item;
1518    protect(env, foo);    protect(foo);
1519    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1520    
1521    iterator= foo->content.ptr;    iterator= foo->content.ptr;
# Line 1307  extern void foreach(environment *env) { Line 1526  extern void foreach(environment *env) {
1526      eval(env); if(env->err) return;      eval(env); if(env->err) return;
1527      iterator= iterator->next;      iterator= iterator->next;
1528    }    }
1529    unprotect(env); unprotect(env);    unprotect(loop); unprotect(foo);
1530  }  }
1531    
1532  /* "to" */  /* "to" */
1533  extern void to(environment *env) {  extern void to(environment *env)
1534    int i, start, ending;  {
1535    stackitem *temp_head;    int ending, start, i;
1536    value *temp_val;    stackitem *iterator, *temp;
1537        value *pack;
1538    
1539    if((env->head)==NULL || env->head->next==NULL) {    if((env->head)==NULL || env->head->next==NULL) {
1540      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1541      env->err=1;      env->err=1;
# Line 1329  extern void to(environment *env) { Line 1549  extern void to(environment *env) {
1549      return;      return;
1550    }    }
1551    
1552    ending= env->head->item->content.val;    ending= env->head->item->content.i;
1553    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1554    start= env->head->item->content.val;    start= env->head->item->content.i;
1555    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1556    
1557    temp_head= env->head;    push_sym(env, "[");
   env->head= NULL;  
1558    
1559    if(ending>=start) {    if(ending>=start) {
1560      for(i= ending; i>=start; i--)      for(i= ending; i>=start; i--)
# Line 1345  extern void to(environment *env) { Line 1564  extern void to(environment *env) {
1564        push_int(env, i);        push_int(env, i);
1565    }    }
1566    
1567    temp_val= new_val(env);    iterator= env->head;
1568    temp_val->content.ptr= env->head;    pack= new_val(env);
1569    temp_val->type= list;    protect(pack);
1570    env->head= temp_head;  
1571    push_val(env, temp_val);    if(iterator==NULL
1572         || (iterator->item->type==symb
1573         && ((symbol*)(iterator->item->content.ptr))->id[0]=='[')) {
1574        temp= NULL;
1575        toss(env);
1576      } else {
1577        /* Search for first delimiter */
1578        while(iterator->next!=NULL
1579              && (iterator->next->item->type!=symb
1580              || ((symbol*)(iterator->next->item->content.ptr))->id[0]!='['))
1581          iterator= iterator->next;
1582        
1583        /* Extract list */
1584        temp= env->head;
1585        env->head= iterator->next;
1586        iterator->next= NULL;
1587    
1588        pack->type= list;
1589        pack->content.ptr= temp;
1590        
1591        if(env->head!=NULL)
1592          toss(env);
1593      }
1594    
1595      /* Push list */
1596    
1597      push_val(env, pack);
1598    
1599      unprotect(pack);
1600  }  }
1601    
1602  /* Read a string */  /* Read a string */
1603  extern void readline(environment *env) {  extern void readline(environment *env)
1604    {
1605    char in_string[101];    char in_string[101];
1606    
1607    if(fgets(in_string, 100, env->inputstream)==NULL)    if(fgets(in_string, 100, env->inputstream)==NULL)
# Line 1363  extern void readline(environment *env) { Line 1611  extern void readline(environment *env) {
1611  }  }
1612    
1613  /* "read"; Read a value and place on stack */  /* "read"; Read a value and place on stack */
1614  extern void sx_72656164(environment *env) {  extern void sx_72656164(environment *env)
1615    {
1616    const char symbform[]= "%[a-zA-Z0-9!$%*+./:<=>?@^_~-]%n";    const char symbform[]= "%[a-zA-Z0-9!$%*+./:<=>?@^_~-]%n";
1617    const char strform[]= "\"%[^\"]\"%n";    const char strform[]= "\"%[^\"]\"%n";
1618    const char intform[]= "%i%n";    const char intform[]= "%i%n";
1619      const char fltform[]= "%f%n";
1620    const char blankform[]= "%*[ \t]%n";    const char blankform[]= "%*[ \t]%n";
1621    const char ebrackform[]= "]%n";    const char ebrackform[]= "]%n";
1622    const char semicform[]= ";%n";    const char semicform[]= ";%n";
1623    const char bbrackform[]= "[%n";    const char bbrackform[]= "[%n";
1624    
1625    int itemp, readlength= -1;    int itemp, readlength= -1;
1626      int count= -1;
1627      float ftemp;
1628    static int depth= 0;    static int depth= 0;
1629    char *match;    char *match, *ctemp;
1630    size_t inlength;    size_t inlength;
1631    
1632    if(env->in_string==NULL) {    if(env->in_string==NULL) {
# Line 1397  extern void sx_72656164(environment *env Line 1649  extern void sx_72656164(environment *env
1649    inlength= strlen(env->in_string)+1;    inlength= strlen(env->in_string)+1;
1650    match= malloc(inlength);    match= malloc(inlength);
1651    
1652    if(sscanf(env->in_string, blankform, &readlength)!=EOF    if(sscanf(env->in_string, blankform, &readlength) != EOF
1653       && readlength != -1) {       && readlength != -1) {
1654      ;      ;
1655    } else if(sscanf(env->in_string, intform, &itemp, &readlength) != EOF    } else if(sscanf(env->in_string, fltform, &ftemp, &readlength) != EOF
1656              && readlength != -1) {              && readlength != -1) {
1657      push_int(env, itemp);      if(sscanf(env->in_string, intform, &itemp, &count) != EOF
1658           && count==readlength) {
1659          push_int(env, itemp);
1660        } else {
1661          push_float(env, ftemp);
1662        }
1663    } else if(sscanf(env->in_string, strform, match, &readlength) != EOF    } else if(sscanf(env->in_string, strform, match, &readlength) != EOF
1664              && readlength != -1) {              && readlength != -1) {
1665      push_cstring(env, match);      push_cstring(env, match);
# Line 1424  extern void sx_72656164(environment *env Line 1681  extern void sx_72656164(environment *env
1681      free(env->free_string);      free(env->free_string);
1682      env->in_string = env->free_string = NULL;      env->in_string = env->free_string = NULL;
1683    }    }
1684    if ( env->in_string != NULL) {    if (env->in_string != NULL) {
1685      env->in_string += readlength;      env->in_string += readlength;
1686    }    }
1687    
# Line 1434  extern void sx_72656164(environment *env Line 1691  extern void sx_72656164(environment *env
1691      return sx_72656164(env);      return sx_72656164(env);
1692  }  }
1693    
1694  extern void beep(environment *env) {  extern void beep(environment *env)
1695    {
1696    int freq, dur, period, ticks;    int freq, dur, period, ticks;
1697    
1698    if((env->head)==NULL || env->head->next==NULL) {    if((env->head)==NULL || env->head->next==NULL) {
# Line 1451  extern void beep(environment *env) { Line 1708  extern void beep(environment *env) {
1708      return;      return;
1709    }    }
1710    
1711    dur=env->head->item->content.val;    dur=env->head->item->content.i;
1712    toss(env);    toss(env);
1713    freq=env->head->item->content.val;    freq=env->head->item->content.i;
1714    toss(env);    toss(env);
1715    
1716    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 1732  extern void beep(environment *env) {
1732    default:    default:
1733      abort();      abort();
1734    }    }
1735  };  }
1736    
1737  /* "wait" */  /* "wait" */
1738  extern void sx_77616974(environment *env) {  extern void sx_77616974(environment *env)
1739    {
1740    int dur;    int dur;
1741    
1742    if((env->head)==NULL) {    if((env->head)==NULL) {
# Line 1494  extern void sx_77616974(environment *env Line 1751  extern void sx_77616974(environment *env
1751      return;      return;
1752    }    }
1753    
1754    dur=env->head->item->content.val;    dur=env->head->item->content.i;
1755    toss(env);    toss(env);
1756    
1757    usleep(dur);    usleep(dur);
1758  };  }
1759    
1760  extern void copying(environment *env){  extern void copying(environment *env)
1761    {
1762    printf("GNU GENERAL PUBLIC LICENSE\n\    printf("GNU GENERAL PUBLIC LICENSE\n\
1763                         Version 2, June 1991\n\                         Version 2, June 1991\n\
1764  \n\  \n\
# Line 1759  of preserving the free status of all der Line 2017  of preserving the free status of all der
2017  of promoting the sharing and reuse of software generally.\n");  of promoting the sharing and reuse of software generally.\n");
2018  }  }
2019    
2020  extern void warranty(environment *env){  extern void warranty(environment *env)
2021    {
2022    printf("                          NO WARRANTY\n\    printf("                          NO WARRANTY\n\
2023  \n\  \n\
2024    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 1782  YOU OR THIRD PARTIES OR A FAILURE OF THE Line 2041  YOU OR THIRD PARTIES OR A FAILURE OF THE
2041  PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE\n\  PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE\n\
2042  POSSIBILITY OF SUCH DAMAGES.\n");  POSSIBILITY OF SUCH DAMAGES.\n");
2043  }  }
2044    
2045    /* "*" */
2046    extern void sx_2a(environment *env)
2047    {
2048      int a, b;
2049      float fa, fb;
2050    
2051      if((env->head)==NULL || env->head->next==NULL) {
2052        printerr("Too Few Arguments");
2053        env->err=1;
2054        return;
2055      }
2056      
2057      if(env->head->item->type==integer
2058         && env->head->next->item->type==integer) {
2059        a=env->head->item->content.i;
2060        toss(env); if(env->err) return;
2061        b=env->head->item->content.i;
2062        toss(env); if(env->err) return;
2063        push_int(env, b*a);
2064    
2065        return;
2066      }
2067    
2068      if(env->head->item->type==tfloat
2069         && env->head->next->item->type==tfloat) {
2070        fa= env->head->item->content.f;
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*fa);
2075        
2076        return;
2077      }
2078    
2079      if(env->head->item->type==tfloat
2080         && env->head->next->item->type==integer) {
2081        fa= env->head->item->content.f;
2082        toss(env); if(env->err) return;
2083        b= env->head->item->content.i;
2084        toss(env); if(env->err) return;
2085        push_float(env, b*fa);
2086        
2087        return;
2088      }
2089    
2090      if(env->head->item->type==integer
2091         && env->head->next->item->type==tfloat) {
2092        a= env->head->item->content.i;
2093        toss(env); if(env->err) return;
2094        fb= env->head->item->content.f;
2095        toss(env); if(env->err) return;
2096        push_float(env, fb*a);
2097    
2098        return;
2099      }
2100    
2101      printerr("Bad Argument Type");
2102      env->err=2;
2103    }
2104    
2105    /* "/" */
2106    extern void sx_2f(environment *env)
2107    {
2108      int a, b;
2109      float fa, fb;
2110    
2111      if((env->head)==NULL || env->head->next==NULL) {
2112        printerr("Too Few Arguments");
2113        env->err=1;
2114        return;
2115      }
2116      
2117      if(env->head->item->type==integer
2118         && env->head->next->item->type==integer) {
2119        a=env->head->item->content.i;
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/a);
2124    
2125        return;
2126      }
2127    
2128      if(env->head->item->type==tfloat
2129         && env->head->next->item->type==tfloat) {
2130        fa= env->head->item->content.f;
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/fa);
2135        
2136        return;
2137      }
2138    
2139      if(env->head->item->type==tfloat
2140         && env->head->next->item->type==integer) {
2141        fa= env->head->item->content.f;
2142        toss(env); if(env->err) return;
2143        b= env->head->item->content.i;
2144        toss(env); if(env->err) return;
2145        push_float(env, b/fa);
2146        
2147        return;
2148      }
2149    
2150      if(env->head->item->type==integer
2151         && env->head->next->item->type==tfloat) {
2152        a= env->head->item->content.i;
2153        toss(env); if(env->err) return;
2154        fb= env->head->item->content.f;
2155        toss(env); if(env->err) return;
2156        push_float(env, fb/a);
2157    
2158        return;
2159      }
2160    
2161      printerr("Bad Argument Type");
2162      env->err=2;
2163    }
2164    
2165    /* "mod" */
2166    extern void mod(environment *env)
2167    {
2168      int a, b;
2169    
2170      if((env->head)==NULL || env->head->next==NULL) {
2171        printerr("Too Few Arguments");
2172        env->err= 1;
2173        return;
2174      }
2175      
2176      if(env->head->item->type==integer
2177         && env->head->next->item->type==integer) {
2178        a= env->head->item->content.i;
2179        toss(env); if(env->err) return;
2180        b= env->head->item->content.i;
2181        toss(env); if(env->err) return;
2182        push_int(env, b%a);
2183    
2184        return;
2185      }
2186    
2187      printerr("Bad Argument Type");
2188      env->err=2;
2189    }
2190    
2191    /* "div" */
2192    extern void sx_646976(environment *env)
2193    {
2194      int a, b;
2195      
2196      if((env->head)==NULL || env->head->next==NULL) {
2197        printerr("Too Few Arguments");
2198        env->err= 1;
2199        return;
2200      }
2201    
2202      if(env->head->item->type==integer
2203         && env->head->next->item->type==integer) {
2204        a= env->head->item->content.i;
2205        toss(env); if(env->err) return;
2206        b= env->head->item->content.i;
2207        toss(env); if(env->err) return;
2208        push_int(env, (int)b/a);
2209    
2210        return;
2211      }
2212    
2213      printerr("Bad Argument Type");
2214      env->err= 2;
2215    }
Legend:
Removed from v.1.91  
changed lines
  Added in v.1.101
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26