/[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.100 by teddy, Sun Mar 10 12:05:20 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 81  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 */
   
   env->gc_limit--;  
   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 127  value* new_val(environment *env) Line 123  value* new_val(environment *env)
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      nval->gc.flag.mark= 0;
128    protect(env, nval);    nval->gc.flag.protect= 0;
   gc_init(env);  
   unprotect(env);  
129    
130    return nval;    return nval;
131  }  }
132    
133  /* Mark values recursively.  /* Mark values recursively.
134     Marked values are not collected by the GC. */     Marked values are not collected by the GC. */
135  void gc_mark(value *val)  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 157  void gc_mark(value *val) Line 151  void gc_mark(value *val)
151    }    }
152  }  }
153    
154    inline void gc_maybe(environment *env)
155    {
156      if(env->gc_count < env->gc_limit)
157        return;
158      else
159        return gc_init(env);
160    }
161    
162  /* Start GC */  /* Start GC */
163  extern void gc_init(environment *env)  extern void gc_init(environment *env)
164  {  {
# Line 164  extern void gc_init(environment *env) Line 166  extern void gc_init(environment *env)
166    symbol *tsymb;    symbol *tsymb;
167    int i;    int i;
168    
169    if(env->gc_count < env->gc_limit)    if(env->interactive){
170      return;      printf("Garbage collecting.", env->gc_count, env->gc_limit);
   
   /* 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    }    }
172    
173    /* Mark values on stack */    /* Mark values on stack */
# Line 188  extern void gc_init(environment *env) Line 177  extern void gc_init(environment *env)
177      iterator= iterator->next;      iterator= iterator->next;
178    }    }
179    
180      if(env->interactive){
181        printf(".");
182      }
183    
184    /* Mark values in hashtable */    /* 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    while(env->gc_ref!=NULL) {    /* Sweep unused values */    while(env->gc_ref!=NULL) {    /* Sweep unused values */
201    
202      if(env->gc_ref->item->gc_garb) {      if(!(env->gc_ref->item->gc.no_gc)){ /* neither mark nor protect */
203    
204        switch(env->gc_ref->item->type) { /* Remove content */        switch(env->gc_ref->item->type) { /* Remove content */
205        case string:        case string:
# Line 213  extern void gc_init(environment *env) Line 211  extern void gc_init(environment *env)
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);  /* Remove from gc_ref */        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);        /* Remove value */        free(env->gc_ref);        /* Remove value */
219        env->gc_ref= titem;        env->gc_ref= titem;
220      } else {                    /* Keep values */        continue;
221        titem= env->gc_ref->next;      } else {
222        env->gc_ref->next= new_head;        env->gc_count += sizeof(value);
       new_head= env->gc_ref;  
       env->gc_ref= titem;  
       env->gc_count++;  
223      }      }
224        
225        /* Keep values */
226        titem= env->gc_ref->next;
227        env->gc_ref->next= new_head;
228        new_head= env->gc_ref;
229        new_head->item->gc.flag.mark= 0;
230        env->gc_ref= titem;
231    }    }
232    
233    env->gc_limit= env->gc_count*2;    if (env->gc_limit < env->gc_count*2)
234        env->gc_limit= env->gc_count*2;
235    env->gc_ref= new_head;    env->gc_ref= new_head;
236    
237      if(env->interactive){
238        printf("done\n");
239      }
240    
241  }  }
242    
243  /* Protect values from GC */  /* Protect values from GC */
244  void protect(environment *env, value *val)  void protect(value *val)
245  {  {
246    stackitem *new_item= malloc(sizeof(stackitem));    stackitem *iterator;
247    new_item->item= val;  
248    new_item->next= env->gc_protect;    if(val->gc.flag.protect)
249    env->gc_protect= new_item;      return;
250    
251      val->gc.flag.protect= 1;
252    
253      if(val->type==list) {
254        iterator= val->content.ptr;
255    
256        while(iterator!=NULL) {
257          protect(iterator->item);
258          iterator= iterator->next;
259        }
260      }
261  }  }
262    
263  /* Unprotect values from GC */  /* Unprotect values from GC */
264  void unprotect(environment *env)  void unprotect(value *val)
265  {  {
266    stackitem *temp= env->gc_protect;    stackitem *iterator;
267    env->gc_protect= env->gc_protect->next;  
268    free(temp);    if(!(val->gc.flag.protect))
269        return;
270    
271      val->gc.flag.protect= 0;
272    
273      if(val->type==list) {
274        iterator= val->content.ptr;
275    
276        while(iterator!=NULL) {
277          unprotect(iterator->item);
278          iterator= iterator->next;
279        }
280      }
281  }  }
282    
283  /* Push a value onto the stack */  /* Push a value onto the stack */
# Line 354  void push_sym(environment *env, const ch Line 383  void push_sym(environment *env, const ch
383    char *mangled;                /* Mangled function name */    char *mangled;                /* Mangled function name */
384    
385    new_value= new_val(env);    new_value= new_val(env);
386    protect(env, new_value);    protect(new_value);
387    new_fvalue= new_val(env);    new_fvalue= new_val(env);
388    protect(env, new_fvalue);    protect(new_fvalue);
389    
390    /* The new value is a symbol */    /* The new value is a symbol */
391    new_value->type= symb;    new_value->type= symb;
# Line 402  void push_sym(environment *env, const ch Line 431  void push_sym(environment *env, const ch
431    }    }
432    
433    push_val(env, new_value);    push_val(env, new_value);
434    unprotect(env); unprotect(env);    unprotect(new_value); unprotect(new_fvalue);
435  }  }
436    
437  /* Print newline. */  /* Print newline. */
# Line 595  extern void rcl(environment *env) Line 624  extern void rcl(environment *env)
624      env->err=3;      env->err=3;
625      return;      return;
626    }    }
627    protect(env, val);    protect(val);
628    toss(env);            /* toss the symbol */    toss(env);            /* toss the symbol */
629    if(env->err) return;    if(env->err) return;
630    push_val(env, val); /* Return its bound value */    push_val(env, val); /* Return its bound value */
631    unprotect(env);    unprotect(val);
632  }  }
633    
634  /* 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 642  extern void eval(environment *env)
642    
643   eval_start:   eval_start:
644    
645      gc_maybe(env);
646    
647    if(env->head==NULL) {    if(env->head==NULL) {
648      printerr("Too Few Arguments");      printerr("Too Few Arguments");
649      env->err=1;      env->err=1;
# Line 639  extern void eval(environment *env) Line 670  extern void eval(environment *env)
670      /* If it's a list */      /* If it's a list */
671    case list:    case list:
672      temp_val= env->head->item;      temp_val= env->head->item;
673      protect(env, temp_val);      protect(temp_val);
674    
675      toss(env); if(env->err) return;      toss(env); if(env->err) return;
676      iterator= (stackitem*)temp_val->content.ptr;      iterator= (stackitem*)temp_val->content.ptr;
# Line 648  extern void eval(environment *env) Line 679  extern void eval(environment *env)
679        push_val(env, iterator->item);        push_val(env, iterator->item);
680                
681        if(env->head->item->type==symb        if(env->head->item->type==symb
682          && strcmp(";", ((symbol*)(env->head->item->content.ptr))->id)==0) {           && (((symbol*)(env->head->item->content.ptr))->id[0] == ';')) {
683          toss(env);          toss(env);
684          if(env->err) return;          if(env->err) return;
685                    
# Line 660  extern void eval(environment *env) Line 691  extern void eval(environment *env)
691        }        }
692        iterator= iterator->next;        iterator= iterator->next;
693      }      }
694      unprotect(env);      unprotect(temp_val);
695      return;      return;
696    
697    default:    default:
# Line 704  extern void pack(environment *env) Line 735  extern void pack(environment *env)
735    
736    iterator= env->head;    iterator= env->head;
737    pack= new_val(env);    pack= new_val(env);
738    protect(env, pack);    protect(pack);
739    
740    if(iterator==NULL    if(iterator==NULL
741       || (iterator->item->type==symb       || (iterator->item->type==symb
# Line 735  extern void pack(environment *env) Line 766  extern void pack(environment *env)
766    push_val(env, pack);    push_val(env, pack);
767    rev(env);    rev(env);
768    
769    unprotect(env);    unprotect(pack);
770  }  }
771    
772  /* Relocate elements of the list on the stack. */  /* Relocate elements of the list on the stack. */
# Line 869  extern void quit(environment *env) Line 900  extern void quit(environment *env)
900    }    }
901    
902    env->gc_limit= 0;    env->gc_limit= 0;
903    gc_init(env);    gc_maybe(env);
904    
905    if(env->free_string!=NULL)    if(env->free_string!=NULL)
906      free(env->free_string);      free(env->free_string);
# Line 1008  under certain conditions; type `copying; Line 1039  under certain conditions; type `copying;
1039        toss(&myenv);             /* No error check in main */        toss(&myenv);             /* No error check in main */
1040        eval(&myenv);        eval(&myenv);
1041      }      }
1042      gc_init(&myenv);      gc_maybe(&myenv);
1043    }    }
1044    quit(&myenv);    quit(&myenv);
1045    return EXIT_FAILURE;    return EXIT_FAILURE;
# Line 1033  extern void sx_2b(environment *env) Line 1064  extern void sx_2b(environment *env)
1064       && env->head->next->item->type==string) {       && env->head->next->item->type==string) {
1065      a_val= env->head->item;      a_val= env->head->item;
1066      b_val= env->head->next->item;      b_val= env->head->next->item;
1067      protect(env, a_val); protect(env, b_val);      protect(a_val); protect(b_val);
1068      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1069      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1070      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 1072  extern void sx_2b(environment *env)
1072      strcpy(new_string, b_val->content.ptr);      strcpy(new_string, b_val->content.ptr);
1073      strcat(new_string, a_val->content.ptr);      strcat(new_string, a_val->content.ptr);
1074      push_cstring(env, new_string);      push_cstring(env, new_string);
1075      unprotect(env); unprotect(env);      unprotect(a_val); unprotect(b_val);
1076      free(new_string);      free(new_string);
1077            
1078      return;      return;
# Line 1242  value *copy_val(environment *env, value Line 1273  value *copy_val(environment *env, value
1273    stackitem *old_item, *new_item, *prev_item;    stackitem *old_item, *new_item, *prev_item;
1274    value *new_value;    value *new_value;
1275    
1276    protect(env, old_value);    protect(old_value);
1277    new_value= new_val(env);    new_value= new_val(env);
1278    protect(env, new_value);    protect(new_value);
1279    new_value->type= old_value->type;    new_value->type= old_value->type;
1280    
1281    switch(old_value->type){    switch(old_value->type){
# Line 1279  value *copy_val(environment *env, value Line 1310  value *copy_val(environment *env, value
1310      break;      break;
1311    }    }
1312    
1313    unprotect(env); unprotect(env);    unprotect(old_value); unprotect(new_value);
1314    
1315    return new_value;    return new_value;
1316  }  }
# Line 1375  extern void sx_7768696c65(environment *e Line 1406  extern void sx_7768696c65(environment *e
1406    }    }
1407    
1408    loop= env->head->item;    loop= env->head->item;
1409    protect(env, loop);    protect(loop);
1410    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1411    
1412    test= env->head->item;    test= env->head->item;
1413    protect(env, test);    protect(test);
1414    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1415    
1416    do {    do {
# Line 1404  extern void sx_7768696c65(environment *e Line 1435  extern void sx_7768696c65(environment *e
1435        
1436    } while(truth);    } while(truth);
1437    
1438    unprotect(env); unprotect(env);    unprotect(loop); unprotect(test);
1439  }  }
1440    
1441    
# Line 1429  extern void sx_666f72(environment *env) Line 1460  extern void sx_666f72(environment *env)
1460    }    }
1461    
1462    loop= env->head->item;    loop= env->head->item;
1463    protect(env, loop);    protect(loop);
1464    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1465    
1466    foo2= env->head->item->content.i;    foo2= env->head->item->content.i;
# Line 1453  extern void sx_666f72(environment *env) Line 1484  extern void sx_666f72(environment *env)
1484        foo1--;        foo1--;
1485      }      }
1486    }    }
1487    unprotect(env);    unprotect(loop);
1488  }  }
1489    
1490  /* Variant of for-loop */  /* Variant of for-loop */
# Line 1475  extern void foreach(environment *env) Line 1506  extern void foreach(environment *env)
1506    }    }
1507    
1508    loop= env->head->item;    loop= env->head->item;
1509    protect(env, loop);    protect(loop);
1510    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1511    
1512    foo= env->head->item;    foo= env->head->item;
1513    protect(env, foo);    protect(foo);
1514    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1515    
1516    iterator= foo->content.ptr;    iterator= foo->content.ptr;
# Line 1490  extern void foreach(environment *env) Line 1521  extern void foreach(environment *env)
1521      eval(env); if(env->err) return;      eval(env); if(env->err) return;
1522      iterator= iterator->next;      iterator= iterator->next;
1523    }    }
1524    unprotect(env); unprotect(env);    unprotect(loop); unprotect(foo);
1525  }  }
1526    
1527  /* "to" */  /* "to" */
# Line 1530  extern void to(environment *env) Line 1561  extern void to(environment *env)
1561    
1562    iterator= env->head;    iterator= env->head;
1563    pack= new_val(env);    pack= new_val(env);
1564    protect(env, pack);    protect(pack);
1565    
1566    if(iterator==NULL    if(iterator==NULL
1567       || (iterator->item->type==symb       || (iterator->item->type==symb
# Line 1560  extern void to(environment *env) Line 1591  extern void to(environment *env)
1591    
1592    push_val(env, pack);    push_val(env, pack);
1593    
1594    unprotect(env);    unprotect(pack);
1595  }  }
1596    
1597  /* Read a string */  /* Read a string */
Legend:
Removed from v.1.95  
changed lines
  Added in v.1.100
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26