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

Diff of /stack/stack.c

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

revision 1.113 by teddy, Sun Mar 17 00:55:58 2002 UTC revision 1.115 by teddy, Sun Mar 17 11:26:35 2002 UTC
# Line 165  inline void gc_maybe(environment *env) Line 165  inline void gc_maybe(environment *env)
165  extern void gc_init(environment *env)  extern void gc_init(environment *env)
166  {  {
167    stackitem *new_head= NULL, *titem;    stackitem *new_head= NULL, *titem;
168    cons *iterator;    pair *iterator;
169    symbol *tsymb;    symbol *tsymb;
170    int i;    int i;
171    
# Line 233  extern void gc_init(environment *env) Line 233  extern void gc_init(environment *env)
233      /* Keep values */          /* Keep values */    
234      env->gc_count += sizeof(value);      env->gc_count += sizeof(value);
235      if(env->gc_ref->item->type==string)      if(env->gc_ref->item->type==string)
236        env->gc_count += strlen(env->gc_ref->item->content.ptr);        env->gc_count += strlen(env->gc_ref->item->content.ptr)+1;
237            
238      titem= env->gc_ref->next;      titem= env->gc_ref->next;
239      env->gc_ref->next= new_head;      env->gc_ref->next= new_head;
# Line 285  void push_val(environment *env, value *v Line 285  void push_val(environment *env, value *v
285  {  {
286    value *new_value= new_val(env);    value *new_value= new_val(env);
287    
288    new_value->content.c= malloc(sizeof(cons));    new_value->content.c= malloc(sizeof(pair));
289    assert(new_value->content.c!=NULL);    assert(new_value->content.c!=NULL);
290    new_value->type= tcons;    new_value->type= tcons;
291    CAR(new_value)= val;    CAR(new_value)= val;
# Line 484  extern void type(environment *env) Line 484  extern void type(environment *env)
484    toss(env);    toss(env);
485  }      }    
486    
487  /* Prints the top element of the stack. */  /* Print a value */
488  void print_val(value *val, int noquote)  void print_val(value *val, int noquote)
489  {  {
490    switch(val->type) {    switch(val->type) {
# Line 513  void print_val(value *val, int noquote) Line 513  void print_val(value *val, int noquote)
513      printf("[ ");      printf("[ ");
514      do {      do {
515        print_val(CAR(val), noquote);        print_val(CAR(val), noquote);
516        switch(CDR(val)->type){        val= CDR(val);
517          switch(val->type){
518        case empty:        case empty:
519          break;          break;
520        case tcons:        case tcons:
# Line 521  void print_val(value *val, int noquote) Line 522  void print_val(value *val, int noquote)
522          break;          break;
523        default:        default:
524          printf(" . ");          /* Improper list */          printf(" . ");          /* Improper list */
525          print_val(CDR(val), noquote);          print_val(val, noquote);
526        }        }
       val= CDR(val);  
527      } while(val->type == tcons);      } while(val->type == tcons);
528      printf(" ]");      printf(" ]");
529      break;      break;
# Line 1332  value *copy_val(environment *env, value Line 1332  value *copy_val(environment *env, value
1332      break;      break;
1333    case tcons:    case tcons:
1334    
1335      new_value->content.c= malloc(sizeof(cons));      new_value->content.c= malloc(sizeof(pair));
1336      assert(new_value->content.c!=NULL);      assert(new_value->content.c!=NULL);
1337    
1338      CAR(new_value)= copy_val(env, CAR(old_value)); /* recurse */      CAR(new_value)= copy_val(env, CAR(old_value)); /* recurse */
# Line 1725  extern void sx_72656164(environment *env Line 1725  extern void sx_72656164(environment *env
1725      } else {      } else {
1726        push_float(env, ftemp);        push_float(env, ftemp);
1727      }      }
1728      } else if(sscanf(env->in_string, "\"\"%n", &readlength) != EOF
1729                && readlength != -1) {
1730        push_cstring(env, "");
1731    } else if(sscanf(env->in_string, strform, match, &readlength) != EOF    } else if(sscanf(env->in_string, strform, match, &readlength) != EOF
1732              && readlength != -1) {              && readlength != -1) {
1733      push_cstring(env, match);      push_cstring(env, match);
# Line 2350  extern void cdr(environment *env) Line 2353  extern void cdr(environment *env)
2353    
2354    CAR(env->head)=CDR(CAR(env->head));    CAR(env->head)=CDR(CAR(env->head));
2355  }  }
2356    
2357    extern void cons(environment *env)
2358    {
2359      value *val;
2360    
2361      if(env->head->type==empty || CDR(env->head)->type==empty) {
2362        printerr("Too Few Arguments");
2363        env->err= 1;
2364        return;
2365      }
2366    
2367      val=new_val(env);
2368      val->content.c= malloc(sizeof(pair));
2369      assert(val->content.c!=NULL);
2370      val->type=tcons;
2371    
2372      CAR(val)= CAR(CDR(env->head));
2373      CDR(val)= CAR(env->head);
2374    
2375      push_val(env, val);
2376    
2377      swap(env); if(env->err) return;
2378      toss(env); if(env->err) return;
2379      swap(env); if(env->err) return;
2380      toss(env); if(env->err) return;
2381    }
Legend:
Removed from v.1.113  
changed lines
  Added in v.1.115
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26