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

Diff of /stack/stack.c

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

revision 1.95 by masse, Sun Mar 10 06:34:01 2002 UTC revision 1.99 by teddy, Sun Mar 10 10:06:36 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= 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 83  extern void toss(environment *env) Line 82  extern void toss(environment *env)
82    free(temp);                   /* Free the old top stack item */    free(temp);                   /* Free the old top stack item */
83    
84    env->gc_limit--;    env->gc_limit--;
   gc_init(env);  
85  }  }
86    
87  /* 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 128  value* new_val(environment *env) Line 126  value* new_val(environment *env)
126    env->gc_ref= nitem;    env->gc_ref= nitem;
127    
128    env->gc_count++;    env->gc_count++;
129      nval->gc.flag.mark= 0;
130    protect(env, nval);    nval->gc.flag.protect= 0;
   gc_init(env);  
   unprotect(env);  
131    
132    return nval;    return nval;
133  }  }
134    
135  /* Mark values recursively.  /* Mark values recursively.
136     Marked values are not collected by the GC. */     Marked values are not collected by the GC. */
137  void gc_mark(value *val)  inline void gc_mark(value *val)
138  {  {
139    stackitem *iterator;    stackitem *iterator;
140    
141    if(val==NULL || val->gc_garb==0)    if(val->gc.flag.mark)
142      return;      return;
143    
144    val->gc_garb= 0;    val->gc.flag.mark= 1;
145    
146    if(val->type==list) {    if(val->type==list) {
147      iterator= val->content.ptr;      iterator= val->content.ptr;
# Line 157  void gc_mark(value *val) Line 153  void gc_mark(value *val)
153    }    }
154  }  }
155    
156    inline void gc_maybe(environment *env)
157    {
158      if(env->gc_count < env->gc_limit)
159        return;
160      else
161        return gc_init(env);
162    }
163    
164  /* Start GC */  /* Start GC */
165  extern void gc_init(environment *env)  extern void gc_init(environment *env)
166  {  {
# Line 164  extern void gc_init(environment *env) Line 168  extern void gc_init(environment *env)
168    symbol *tsymb;    symbol *tsymb;
169    int i;    int i;
170    
   if(env->gc_count < env->gc_limit)  
     return;  
   
   /* Garb by default */  
   iterator= env->gc_ref;  
   while(iterator!=NULL) {  
     iterator->item->gc_garb= 1;  
     iterator= iterator->next;  
   }  
   
   /* Mark protected values */  
   iterator= env->gc_protect;  
   while(iterator!=NULL) {  
     gc_mark(iterator->item);  
     iterator= iterator->next;  
   }  
   
171    /* Mark values on stack */    /* Mark values on stack */
172    iterator= env->head;    iterator= env->head;
173    while(iterator!=NULL) {    while(iterator!=NULL) {
# Line 192  extern void gc_init(environment *env) Line 179  extern void gc_init(environment *env)
179    for(i= 0; i<HASHTBLSIZE; i++) {    for(i= 0; i<HASHTBLSIZE; i++) {
180      tsymb= env->symbols[i];      tsymb= env->symbols[i];
181      while(tsymb!=NULL) {      while(tsymb!=NULL) {
182        gc_mark(tsymb->val);        if (tsymb->val != NULL)
183            gc_mark(tsymb->val);
184        tsymb= tsymb->next;        tsymb= tsymb->next;
185      }      }
186    }    }
# Line 201  extern void gc_init(environment *env) Line 189  extern void gc_init(environment *env)
189    
190    while(env->gc_ref!=NULL) {    /* Sweep unused values */    while(env->gc_ref!=NULL) {    /* Sweep unused values */
191    
192      if(env->gc_ref->item->gc_garb) {      if(!(env->gc_ref->item->gc.no_gc)){ /* neither mark nor 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 213  extern void gc_init(environment *env) Line 201  extern void gc_init(environment *env)
201            env->gc_ref->item->content.ptr= titem->next;            env->gc_ref->item->content.ptr= titem->next;
202            free(titem);            free(titem);
203          }          }
         break;  
204        default:        default:
         break;  
205        }        }
206        free(env->gc_ref->item);  /* Remove from gc_ref */        free(env->gc_ref->item);  /* Remove from gc_ref */
207        titem= env->gc_ref->next;        titem= env->gc_ref->next;
208        free(env->gc_ref);        /* Remove value */        free(env->gc_ref);        /* Remove value */
209        env->gc_ref= titem;        env->gc_ref= titem;
210      } else {                    /* Keep values */        continue;
       titem= env->gc_ref->next;  
       env->gc_ref->next= new_head;  
       new_head= env->gc_ref;  
       env->gc_ref= titem;  
       env->gc_count++;  
211      }      }
212        
213        /* Keep values */
214        titem= env->gc_ref->next;
215        env->gc_ref->next= new_head;
216        new_head= env->gc_ref;
217        new_head->item->gc.flag.mark= 0;
218        env->gc_ref= titem;
219        env->gc_count++;
220    }    }
221    
222    env->gc_limit= env->gc_count*2;    env->gc_limit= env->gc_count*2;
# Line 235  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.flag.protect)
232    env->gc_protect= new_item;      return;
233    
234      val->gc.flag.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.flag.protect))
252        return;
253    
254      val->gc.flag.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 354  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 402  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 595  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 613  extern void eval(environment *env) Line 625  extern void eval(environment *env)
625    
626   eval_start:   eval_start:
627    
628      gc_maybe(env);
629    
630    if(env->head==NULL) {    if(env->head==NULL) {
631      printerr("Too Few Arguments");      printerr("Too Few Arguments");
632      env->err=1;      env->err=1;
# Line 639  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 660  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 704  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 735  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 869  extern void quit(environment *env) Line 883  extern void quit(environment *env)
883    }    }
884    
885    env->gc_limit= 0;    env->gc_limit= 0;
886    gc_init(env);    gc_maybe(env);
887    
888    if(env->free_string!=NULL)    if(env->free_string!=NULL)
889      free(env->free_string);      free(env->free_string);
# Line 1008  under certain conditions; type `copying; Line 1022  under certain conditions; type `copying;
1022        toss(&myenv);             /* No error check in main */        toss(&myenv);             /* No error check in main */
1023        eval(&myenv);        eval(&myenv);
1024      }      }
1025      gc_init(&myenv);      gc_maybe(&myenv);
1026    }    }
1027    quit(&myenv);    quit(&myenv);
1028    return EXIT_FAILURE;    return EXIT_FAILURE;
# Line 1033  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 1041  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 1242  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 1279  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 1375  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 1404  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 1429  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 1453  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 1475  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 1490  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 1530  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 1560  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.95  
changed lines
  Added in v.1.99
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26