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

Diff of /stack/stack.c

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

revision 1.97 by masse, Sun Mar 10 08:30:43 2002 UTC revision 1.98 by masse, Sun Mar 10 09:13:36 2002 UTC
# Line 51  void init_env(environment *env) Line 51  void init_env(environment *env)
51    env->gc_limit= 200;    env->gc_limit= 200;
52    env->gc_count= 0;    env->gc_count= 0;
53    env->gc_ref= NULL;    env->gc_ref= NULL;
   env->gc_protect= NULL;  
54    
55    env->head= NULL;    env->head= NULL;
56    for(i= 0; i<HASHTBLSIZE; i++)    for(i= 0; i<HASHTBLSIZE; i++)
# Line 168  extern void gc_init(environment *env) Line 167  extern void gc_init(environment *env)
167    symbol *tsymb;    symbol *tsymb;
168    int i;    int i;
169    
   /* Mark protected values */  
   iterator= env->gc_protect;  
   while(iterator!=NULL) {  
     gc_mark(iterator->item);  
     iterator= iterator->next;  
   }  
   
170    /* Mark values on stack */    /* Mark values on stack */
171    iterator= env->head;    iterator= env->head;
172    while(iterator!=NULL) {    while(iterator!=NULL) {
# Line 196  extern void gc_init(environment *env) Line 188  extern void gc_init(environment *env)
188    
189    while(env->gc_ref!=NULL) {    /* Sweep unused values */    while(env->gc_ref!=NULL) {    /* Sweep unused values */
190    
191      if(env->gc_ref->item->gc_garb) {      if(env->gc_ref->item->gc_garb
192           && !(env->gc_ref->item->gc_protect)) {
193    
194        switch(env->gc_ref->item->type) { /* Remove content */        switch(env->gc_ref->item->type) { /* Remove content */
195        case string:        case string:
# Line 231  extern void gc_init(environment *env) Line 224  extern void gc_init(environment *env)
224  }  }
225    
226  /* Protect values from GC */  /* Protect values from GC */
227  void protect(environment *env, value *val)  void protect(value *val)
228  {  {
229    stackitem *new_item= malloc(sizeof(stackitem));    stackitem *iterator;
230    new_item->item= val;  
231    new_item->next= env->gc_protect;    if(val->gc_protect)
232    env->gc_protect= new_item;      return;
233    
234      val->gc_protect= 1;
235    
236      if(val->type==list) {
237        iterator= val->content.ptr;
238    
239        while(iterator!=NULL) {
240          protect(iterator->item);
241          iterator= iterator->next;
242        }
243      }
244  }  }
245    
246  /* Unprotect values from GC */  /* Unprotect values from GC */
247  void unprotect(environment *env)  void unprotect(value *val)
248  {  {
249    stackitem *temp= env->gc_protect;    stackitem *iterator;
250    env->gc_protect= env->gc_protect->next;  
251    free(temp);    if(!(val->gc_protect))
252        return;
253    
254      val->gc_protect= 0;
255    
256      if(val->type==list) {
257        iterator= val->content.ptr;
258    
259        while(iterator!=NULL) {
260          unprotect(iterator->item);
261          iterator= iterator->next;
262        }
263      }
264  }  }
265    
266  /* Push a value onto the stack */  /* Push a value onto the stack */
# Line 350  void push_sym(environment *env, const ch Line 366  void push_sym(environment *env, const ch
366    char *mangled;                /* Mangled function name */    char *mangled;                /* Mangled function name */
367    
368    new_value= new_val(env);    new_value= new_val(env);
369    protect(env, new_value);    protect(new_value);
370    new_fvalue= new_val(env);    new_fvalue= new_val(env);
371    protect(env, new_fvalue);    protect(new_fvalue);
372    
373    /* The new value is a symbol */    /* The new value is a symbol */
374    new_value->type= symb;    new_value->type= symb;
# Line 398  void push_sym(environment *env, const ch Line 414  void push_sym(environment *env, const ch
414    }    }
415    
416    push_val(env, new_value);    push_val(env, new_value);
417    unprotect(env); unprotect(env);    unprotect(new_value); unprotect(new_fvalue);
418  }  }
419    
420  /* Print newline. */  /* Print newline. */
# Line 591  extern void rcl(environment *env) Line 607  extern void rcl(environment *env)
607      env->err=3;      env->err=3;
608      return;      return;
609    }    }
610    protect(env, val);    protect(val);
611    toss(env);            /* toss the symbol */    toss(env);            /* toss the symbol */
612    if(env->err) return;    if(env->err) return;
613    push_val(env, val); /* Return its bound value */    push_val(env, val); /* Return its bound value */
614    unprotect(env);    unprotect(val);
615  }  }
616    
617  /* If the top element is a symbol, determine if it's bound to a  /* If the top element is a symbol, determine if it's bound to a
# Line 637  extern void eval(environment *env) Line 653  extern void eval(environment *env)
653      /* If it's a list */      /* If it's a list */
654    case list:    case list:
655      temp_val= env->head->item;      temp_val= env->head->item;
656      protect(env, temp_val);      protect(temp_val);
657    
658      toss(env); if(env->err) return;      toss(env); if(env->err) return;
659      iterator= (stackitem*)temp_val->content.ptr;      iterator= (stackitem*)temp_val->content.ptr;
# Line 658  extern void eval(environment *env) Line 674  extern void eval(environment *env)
674        }        }
675        iterator= iterator->next;        iterator= iterator->next;
676      }      }
677      unprotect(env);      unprotect(temp_val);
678      return;      return;
679    
680    default:    default:
# Line 702  extern void pack(environment *env) Line 718  extern void pack(environment *env)
718    
719    iterator= env->head;    iterator= env->head;
720    pack= new_val(env);    pack= new_val(env);
721    protect(env, pack);    protect(pack);
722    
723    if(iterator==NULL    if(iterator==NULL
724       || (iterator->item->type==symb       || (iterator->item->type==symb
# Line 733  extern void pack(environment *env) Line 749  extern void pack(environment *env)
749    push_val(env, pack);    push_val(env, pack);
750    rev(env);    rev(env);
751    
752    unprotect(env);    unprotect(pack);
753  }  }
754    
755  /* Relocate elements of the list on the stack. */  /* Relocate elements of the list on the stack. */
# Line 1031  extern void sx_2b(environment *env) Line 1047  extern void sx_2b(environment *env)
1047       && env->head->next->item->type==string) {       && env->head->next->item->type==string) {
1048      a_val= env->head->item;      a_val= env->head->item;
1049      b_val= env->head->next->item;      b_val= env->head->next->item;
1050      protect(env, a_val); protect(env, b_val);      protect(a_val); protect(b_val);
1051      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1052      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1053      len= strlen(a_val->content.ptr)+strlen(b_val->content.ptr)+1;      len= strlen(a_val->content.ptr)+strlen(b_val->content.ptr)+1;
# Line 1039  extern void sx_2b(environment *env) Line 1055  extern void sx_2b(environment *env)
1055      strcpy(new_string, b_val->content.ptr);      strcpy(new_string, b_val->content.ptr);
1056      strcat(new_string, a_val->content.ptr);      strcat(new_string, a_val->content.ptr);
1057      push_cstring(env, new_string);      push_cstring(env, new_string);
1058      unprotect(env); unprotect(env);      unprotect(a_val); unprotect(b_val);
1059      free(new_string);      free(new_string);
1060            
1061      return;      return;
# Line 1240  value *copy_val(environment *env, value Line 1256  value *copy_val(environment *env, value
1256    stackitem *old_item, *new_item, *prev_item;    stackitem *old_item, *new_item, *prev_item;
1257    value *new_value;    value *new_value;
1258    
1259    protect(env, old_value);    protect(old_value);
1260    new_value= new_val(env);    new_value= new_val(env);
1261    protect(env, new_value);    protect(new_value);
1262    new_value->type= old_value->type;    new_value->type= old_value->type;
1263    
1264    switch(old_value->type){    switch(old_value->type){
# Line 1277  value *copy_val(environment *env, value Line 1293  value *copy_val(environment *env, value
1293      break;      break;
1294    }    }
1295    
1296    unprotect(env); unprotect(env);    unprotect(old_value); unprotect(new_value);
1297    
1298    return new_value;    return new_value;
1299  }  }
# Line 1373  extern void sx_7768696c65(environment *e Line 1389  extern void sx_7768696c65(environment *e
1389    }    }
1390    
1391    loop= env->head->item;    loop= env->head->item;
1392    protect(env, loop);    protect(loop);
1393    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1394    
1395    test= env->head->item;    test= env->head->item;
1396    protect(env, test);    protect(test);
1397    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1398    
1399    do {    do {
# Line 1402  extern void sx_7768696c65(environment *e Line 1418  extern void sx_7768696c65(environment *e
1418        
1419    } while(truth);    } while(truth);
1420    
1421    unprotect(env); unprotect(env);    unprotect(loop); unprotect(test);
1422  }  }
1423    
1424    
# Line 1427  extern void sx_666f72(environment *env) Line 1443  extern void sx_666f72(environment *env)
1443    }    }
1444    
1445    loop= env->head->item;    loop= env->head->item;
1446    protect(env, loop);    protect(loop);
1447    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1448    
1449    foo2= env->head->item->content.i;    foo2= env->head->item->content.i;
# Line 1451  extern void sx_666f72(environment *env) Line 1467  extern void sx_666f72(environment *env)
1467        foo1--;        foo1--;
1468      }      }
1469    }    }
1470    unprotect(env);    unprotect(loop);
1471  }  }
1472    
1473  /* Variant of for-loop */  /* Variant of for-loop */
# Line 1473  extern void foreach(environment *env) Line 1489  extern void foreach(environment *env)
1489    }    }
1490    
1491    loop= env->head->item;    loop= env->head->item;
1492    protect(env, loop);    protect(loop);
1493    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1494    
1495    foo= env->head->item;    foo= env->head->item;
1496    protect(env, foo);    protect(foo);
1497    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1498    
1499    iterator= foo->content.ptr;    iterator= foo->content.ptr;
# Line 1488  extern void foreach(environment *env) Line 1504  extern void foreach(environment *env)
1504      eval(env); if(env->err) return;      eval(env); if(env->err) return;
1505      iterator= iterator->next;      iterator= iterator->next;
1506    }    }
1507    unprotect(env); unprotect(env);    unprotect(loop); unprotect(foo);
1508  }  }
1509    
1510  /* "to" */  /* "to" */
# Line 1528  extern void to(environment *env) Line 1544  extern void to(environment *env)
1544    
1545    iterator= env->head;    iterator= env->head;
1546    pack= new_val(env);    pack= new_val(env);
1547    protect(env, pack);    protect(pack);
1548    
1549    if(iterator==NULL    if(iterator==NULL
1550       || (iterator->item->type==symb       || (iterator->item->type==symb
# Line 1558  extern void to(environment *env) Line 1574  extern void to(environment *env)
1574    
1575    push_val(env, pack);    push_val(env, pack);
1576    
1577    unprotect(env);    unprotect(pack);
1578  }  }
1579    
1580  /* Read a string */  /* Read a string */
Legend:
Removed from v.1.97  
changed lines
  Added in v.1.98
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26