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

Diff of /stack/stack.c

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

revision 1.114 by teddy, Sun Mar 17 02:15:01 2002 UTC revision 1.116 by teddy, Sun Mar 17 12:49:27 2002 UTC
# Line 1  Line 1 
1    /* -*- coding: utf-8; -*- */
2  /*  /*
3      stack - an interactive interpreter for a stack-based language      stack - an interactive interpreter for a stack-based language
4      Copyright (C) 2002  Mats Alritzson and Teddy Hogeborn      Copyright (C) 2002  Mats Alritzson and Teddy Hogeborn
# Line 165  inline void gc_maybe(environment *env) Line 166  inline void gc_maybe(environment *env)
166  extern void gc_init(environment *env)  extern void gc_init(environment *env)
167  {  {
168    stackitem *new_head= NULL, *titem;    stackitem *new_head= NULL, *titem;
   cons *iterator;  
169    symbol *tsymb;    symbol *tsymb;
170    int i;    int i;
171    
# Line 195  extern void gc_init(environment *env) Line 195  extern void gc_init(environment *env)
195    
196      if(!(env->gc_ref->item->gc.no_gc)){ /* neither mark nor protect */      if(!(env->gc_ref->item->gc.no_gc)){ /* neither mark nor protect */
197    
198        if(env->gc_ref->item->type==string) /* Remove content */        /* Remove content */
199          switch(env->gc_ref->item->type){
200          case string:
201          free(env->gc_ref->item->content.ptr);          free(env->gc_ref->item->content.ptr);
202            break;
203          case tcons:
204            free(env->gc_ref->item->content.c);
205            break;
206          case empty:
207          case integer:
208          case tfloat:
209          case func:
210          case symb:
211            /* Symbol strings are freed when walking the hash table */
212          }
213    
214        free(env->gc_ref->item);  /* Remove from gc_ref */        free(env->gc_ref->item);  /* Remove from gc_ref */
215        titem= env->gc_ref->next;        titem= env->gc_ref->next;
# Line 285  void push_val(environment *env, value *v Line 298  void push_val(environment *env, value *v
298  {  {
299    value *new_value= new_val(env);    value *new_value= new_val(env);
300    
301    new_value->content.c= malloc(sizeof(cons));    new_value->content.c= malloc(sizeof(pair));
302    assert(new_value->content.c!=NULL);    assert(new_value->content.c!=NULL);
303      env->gc_count += sizeof(pair);
304    new_value->type= tcons;    new_value->type= tcons;
305    CAR(new_value)= val;    CAR(new_value)= val;
306    CDR(new_value)= env->head;    CDR(new_value)= env->head;
# Line 720  extern void eval(environment *env) Line 734  extern void eval(environment *env)
734      unprotect(temp_val);      unprotect(temp_val);
735      return;      return;
736    
737    default:    case empty:
738      case integer:
739      case tfloat:
740      case string:
741      return;      return;
742    }    }
743  }  }
# Line 1324  value *copy_val(environment *env, value Line 1341  value *copy_val(environment *env, value
1341    case integer:    case integer:
1342    case func:    case func:
1343    case symb:    case symb:
1344      case empty:
1345      new_value->content= old_value->content;      new_value->content= old_value->content;
1346      break;      break;
1347    case string:    case string:
# Line 1332  value *copy_val(environment *env, value Line 1350  value *copy_val(environment *env, value
1350      break;      break;
1351    case tcons:    case tcons:
1352    
1353      new_value->content.c= malloc(sizeof(cons));      new_value->content.c= malloc(sizeof(pair));
1354      assert(new_value->content.c!=NULL);      assert(new_value->content.c!=NULL);
1355        env->gc_count += sizeof(pair);
1356    
1357      CAR(new_value)= copy_val(env, CAR(old_value)); /* recurse */      CAR(new_value)= copy_val(env, CAR(old_value)); /* recurse */
1358      CDR(new_value)= copy_val(env, CDR(old_value)); /* recurse */      CDR(new_value)= copy_val(env, CDR(old_value)); /* recurse */
# Line 1691  extern void sx_72656164(environment *env Line 1710  extern void sx_72656164(environment *env
1710    int count= -1;    int count= -1;
1711    float ftemp;    float ftemp;
1712    static int depth= 0;    static int depth= 0;
1713    char *match, *ctemp;    char *match;
1714    size_t inlength;    size_t inlength;
1715    
1716    if(env->in_string==NULL) {    if(env->in_string==NULL) {
# Line 2353  extern void cdr(environment *env) Line 2372  extern void cdr(environment *env)
2372    
2373    CAR(env->head)=CDR(CAR(env->head));    CAR(env->head)=CDR(CAR(env->head));
2374  }  }
2375    
2376    extern void cons(environment *env)
2377    {
2378      value *val;
2379    
2380      if(env->head->type==empty || CDR(env->head)->type==empty) {
2381        printerr("Too Few Arguments");
2382        env->err= 1;
2383        return;
2384      }
2385    
2386      val=new_val(env);
2387      val->content.c= malloc(sizeof(pair));
2388      assert(val->content.c!=NULL);
2389    
2390      env->gc_count += sizeof(pair);
2391      val->type=tcons;
2392    
2393      CAR(val)= CAR(CDR(env->head));
2394      CDR(val)= CAR(env->head);
2395    
2396      push_val(env, val);
2397    
2398      swap(env); if(env->err) return;
2399      toss(env); if(env->err) return;
2400      swap(env); if(env->err) return;
2401      toss(env); if(env->err) return;
2402    }
Legend:
Removed from v.1.114  
changed lines
  Added in v.1.116
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26