/[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.101 by teddy, Sun Mar 10 13:00:01 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= 200;    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--;  
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 126  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_garb= 1;    nval->gc.flag.mark= 0;
128      nval->gc.flag.protect= 0;
129    
130    return nval;    return nval;
131  }  }
# Line 138  inline void gc_mark(value *val) Line 136  inline void gc_mark(value *val)
136  {  {
137    stackitem *iterator;    stackitem *iterator;
138    
139    if(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 168  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    /* Mark protected values */    if(env->interactive){
170    iterator= env->gc_protect;      printf("Garbage collecting.");
   while(iterator!=NULL) {  
     gc_mark(iterator->item);  
     iterator= iterator->next;  
171    }    }
172    
173    /* Mark values on stack */    /* Mark values on stack */
# Line 182  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];
# Line 192  extern void gc_init(environment *env) Line 191  extern void gc_init(environment *env)
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 215  extern void gc_init(environment *env) Line 218  extern void gc_init(environment *env)
218        free(env->gc_ref);        /* Remove value */        free(env->gc_ref);        /* Remove value */
219        env->gc_ref= titem;        env->gc_ref= titem;
220        continue;        continue;
221        } else {
222          env->gc_count += sizeof(value);
223          if(env->gc_ref->item->type == string)
224            env->gc_count += strlen(env->gc_ref->item->content.ptr);
225      }      }
226            
227      /* Keep values */      /* Keep values */
228      titem= env->gc_ref->next;      titem= env->gc_ref->next;
229      env->gc_ref->next= new_head;      env->gc_ref->next= new_head;
230      new_head= env->gc_ref;      new_head= env->gc_ref;
231      new_head->item->gc_garb= 1;      new_head->item->gc.flag.mark= 0;
232      env->gc_ref= titem;      env->gc_ref= titem;
     env->gc_count++;  
233    }    }
234    
235    env->gc_limit= env->gc_count*2;    if (env->gc_limit < env->gc_count*2)
236        env->gc_limit= env->gc_count*2;
237    
238    env->gc_ref= new_head;    env->gc_ref= new_head;
239    
240      if(env->interactive){
241        printf("done\n");
242      }
243    
244  }  }
245    
246  /* Protect values from GC */  /* Protect values from GC */
247  void protect(environment *env, value *val)  void protect(value *val)
248  {  {
249    stackitem *new_item= malloc(sizeof(stackitem));    stackitem *iterator;
250    new_item->item= val;  
251    new_item->next= env->gc_protect;    if(val->gc.flag.protect)
252    env->gc_protect= new_item;      return;
253    
254      val->gc.flag.protect= 1;
255    
256      if(val->type==list) {
257        iterator= val->content.ptr;
258    
259        while(iterator!=NULL) {
260          protect(iterator->item);
261          iterator= iterator->next;
262        }
263      }
264  }  }
265    
266  /* Unprotect values from GC */  /* Unprotect values from GC */
267  void unprotect(environment *env)  void unprotect(value *val)
268  {  {
269    stackitem *temp= env->gc_protect;    stackitem *iterator;
270    env->gc_protect= env->gc_protect->next;  
271    free(temp);    if(!(val->gc.flag.protect))
272        return;
273    
274      val->gc.flag.protect= 0;
275    
276      if(val->type==list) {
277        iterator= val->content.ptr;
278    
279        while(iterator!=NULL) {
280          unprotect(iterator->item);
281          iterator= iterator->next;
282        }
283      }
284  }  }
285    
286  /* Push a value onto the stack */  /* Push a value onto the stack */
# Line 282  void push_float(environment *env, float Line 318  void push_float(environment *env, float
318  void push_cstring(environment *env, const char *in_string)  void push_cstring(environment *env, const char *in_string)
319  {  {
320    value *new_value= new_val(env);    value *new_value= new_val(env);
321      int length= strlen(in_string)+1;
322    
323    new_value->content.ptr= malloc(strlen(in_string)+1);    new_value->content.ptr= malloc(length);
324      env->gc_count += length;
325    strcpy(new_value->content.ptr, in_string);    strcpy(new_value->content.ptr, in_string);
326    new_value->type= string;    new_value->type= string;
327    
# Line 350  void push_sym(environment *env, const ch Line 388  void push_sym(environment *env, const ch
388    char *mangled;                /* Mangled function name */    char *mangled;                /* Mangled function name */
389    
390    new_value= new_val(env);    new_value= new_val(env);
391    protect(env, new_value);    protect(new_value);
392    new_fvalue= new_val(env);    new_fvalue= new_val(env);
393    protect(env, new_fvalue);    protect(new_fvalue);
394    
395    /* The new value is a symbol */    /* The new value is a symbol */
396    new_value->type= symb;    new_value->type= symb;
# Line 398  void push_sym(environment *env, const ch Line 436  void push_sym(environment *env, const ch
436    }    }
437    
438    push_val(env, new_value);    push_val(env, new_value);
439    unprotect(env); unprotect(env);    unprotect(new_value); unprotect(new_fvalue);
440  }  }
441    
442  /* Print newline. */  /* Print newline. */
# Line 591  extern void rcl(environment *env) Line 629  extern void rcl(environment *env)
629      env->err=3;      env->err=3;
630      return;      return;
631    }    }
632    protect(env, val);    protect(val);
633    toss(env);            /* toss the symbol */    toss(env);            /* toss the symbol */
634    if(env->err) return;    if(env->err) return;
635    push_val(env, val); /* Return its bound value */    push_val(env, val); /* Return its bound value */
636    unprotect(env);    unprotect(val);
637  }  }
638    
639  /* 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 675  extern void eval(environment *env)
675      /* If it's a list */      /* If it's a list */
676    case list:    case list:
677      temp_val= env->head->item;      temp_val= env->head->item;
678      protect(env, temp_val);      protect(temp_val);
679    
680      toss(env); if(env->err) return;      toss(env); if(env->err) return;
681      iterator= (stackitem*)temp_val->content.ptr;      iterator= (stackitem*)temp_val->content.ptr;
# Line 646  extern void eval(environment *env) Line 684  extern void eval(environment *env)
684        push_val(env, iterator->item);        push_val(env, iterator->item);
685                
686        if(env->head->item->type==symb        if(env->head->item->type==symb
687          && strcmp(";", ((symbol*)(env->head->item->content.ptr))->id)==0) {           && (((symbol*)(env->head->item->content.ptr))->id[0] == ';')) {
688          toss(env);          toss(env);
689          if(env->err) return;          if(env->err) return;
690                    
# Line 658  extern void eval(environment *env) Line 696  extern void eval(environment *env)
696        }        }
697        iterator= iterator->next;        iterator= iterator->next;
698      }      }
699      unprotect(env);      unprotect(temp_val);
700      return;      return;
701    
702    default:    default:
# Line 702  extern void pack(environment *env) Line 740  extern void pack(environment *env)
740    
741    iterator= env->head;    iterator= env->head;
742    pack= new_val(env);    pack= new_val(env);
743    protect(env, pack);    protect(pack);
744    
745    if(iterator==NULL    if(iterator==NULL
746       || (iterator->item->type==symb       || (iterator->item->type==symb
# Line 733  extern void pack(environment *env) Line 771  extern void pack(environment *env)
771    push_val(env, pack);    push_val(env, pack);
772    rev(env);    rev(env);
773    
774    unprotect(env);    unprotect(pack);
775  }  }
776    
777  /* 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 1069  extern void sx_2b(environment *env)
1069       && env->head->next->item->type==string) {       && env->head->next->item->type==string) {
1070      a_val= env->head->item;      a_val= env->head->item;
1071      b_val= env->head->next->item;      b_val= env->head->next->item;
1072      protect(env, a_val); protect(env, b_val);      protect(a_val); protect(b_val);
1073      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1074      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1075      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 1077  extern void sx_2b(environment *env)
1077      strcpy(new_string, b_val->content.ptr);      strcpy(new_string, b_val->content.ptr);
1078      strcat(new_string, a_val->content.ptr);      strcat(new_string, a_val->content.ptr);
1079      push_cstring(env, new_string);      push_cstring(env, new_string);
1080      unprotect(env); unprotect(env);      unprotect(a_val); unprotect(b_val);
1081      free(new_string);      free(new_string);
1082            
1083      return;      return;
# Line 1240  value *copy_val(environment *env, value Line 1278  value *copy_val(environment *env, value
1278    stackitem *old_item, *new_item, *prev_item;    stackitem *old_item, *new_item, *prev_item;
1279    value *new_value;    value *new_value;
1280    
1281    protect(env, old_value);    protect(old_value);
1282    new_value= new_val(env);    new_value= new_val(env);
1283    protect(env, new_value);    protect(new_value);
1284    new_value->type= old_value->type;    new_value->type= old_value->type;
1285    
1286    switch(old_value->type){    switch(old_value->type){
# Line 1277  value *copy_val(environment *env, value Line 1315  value *copy_val(environment *env, value
1315      break;      break;
1316    }    }
1317    
1318    unprotect(env); unprotect(env);    unprotect(old_value); unprotect(new_value);
1319    
1320    return new_value;    return new_value;
1321  }  }
# Line 1373  extern void sx_7768696c65(environment *e Line 1411  extern void sx_7768696c65(environment *e
1411    }    }
1412    
1413    loop= env->head->item;    loop= env->head->item;
1414    protect(env, loop);    protect(loop);
1415    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1416    
1417    test= env->head->item;    test= env->head->item;
1418    protect(env, test);    protect(test);
1419    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1420    
1421    do {    do {
# Line 1402  extern void sx_7768696c65(environment *e Line 1440  extern void sx_7768696c65(environment *e
1440        
1441    } while(truth);    } while(truth);
1442    
1443    unprotect(env); unprotect(env);    unprotect(loop); unprotect(test);
1444  }  }
1445    
1446    
# Line 1427  extern void sx_666f72(environment *env) Line 1465  extern void sx_666f72(environment *env)
1465    }    }
1466    
1467    loop= env->head->item;    loop= env->head->item;
1468    protect(env, loop);    protect(loop);
1469    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1470    
1471    foo2= env->head->item->content.i;    foo2= env->head->item->content.i;
# Line 1451  extern void sx_666f72(environment *env) Line 1489  extern void sx_666f72(environment *env)
1489        foo1--;        foo1--;
1490      }      }
1491    }    }
1492    unprotect(env);    unprotect(loop);
1493  }  }
1494    
1495  /* Variant of for-loop */  /* Variant of for-loop */
# Line 1473  extern void foreach(environment *env) Line 1511  extern void foreach(environment *env)
1511    }    }
1512    
1513    loop= env->head->item;    loop= env->head->item;
1514    protect(env, loop);    protect(loop);
1515    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1516    
1517    foo= env->head->item;    foo= env->head->item;
1518    protect(env, foo);    protect(foo);
1519    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1520    
1521    iterator= foo->content.ptr;    iterator= foo->content.ptr;
# Line 1488  extern void foreach(environment *env) Line 1526  extern void foreach(environment *env)
1526      eval(env); if(env->err) return;      eval(env); if(env->err) return;
1527      iterator= iterator->next;      iterator= iterator->next;
1528    }    }
1529    unprotect(env); unprotect(env);    unprotect(loop); unprotect(foo);
1530  }  }
1531    
1532  /* "to" */  /* "to" */
# Line 1528  extern void to(environment *env) Line 1566  extern void to(environment *env)
1566    
1567    iterator= env->head;    iterator= env->head;
1568    pack= new_val(env);    pack= new_val(env);
1569    protect(env, pack);    protect(pack);
1570    
1571    if(iterator==NULL    if(iterator==NULL
1572       || (iterator->item->type==symb       || (iterator->item->type==symb
# Line 1558  extern void to(environment *env) Line 1596  extern void to(environment *env)
1596    
1597    push_val(env, pack);    push_val(env, pack);
1598    
1599    unprotect(env);    unprotect(pack);
1600  }  }
1601    
1602  /* Read a string */  /* Read a string */
Legend:
Removed from v.1.97  
changed lines
  Added in v.1.101
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26