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

Diff of /stack/stack.c

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

revision 1.128 by masse, Mon Aug 4 13:50:53 2003 UTC revision 1.130 by masse, Mon Aug 4 14:32:27 2003 UTC
# Line 153  extern void gc_init(environment *env) Line 153  extern void gc_init(environment *env)
153        /* Remove content */        /* Remove content */
154        switch(env->gc_ref->item->type){        switch(env->gc_ref->item->type){
155        case string:        case string:
156          free(env->gc_ref->item->content.ptr);          free(env->gc_ref->item->content.string);
157          break;          break;
158        case tcons:        case tcons:
159          free(env->gc_ref->item->content.c);          free(env->gc_ref->item->content.c);
# Line 379  void push_sym(environment *env, const ch Line 379  void push_sym(environment *env, const ch
379    
380    /* Look up the symbol name in the hash table */    /* Look up the symbol name in the hash table */
381    new_symbol= hash(env->symbols, in_string);    new_symbol= hash(env->symbols, in_string);
382    new_value->content.ptr= *new_symbol;    new_value->content.sym= *new_symbol;
383    
384    if(*new_symbol==NULL) { /* If symbol was undefined */    if(*new_symbol==NULL) { /* If symbol was undefined */
385    
# Line 393  void push_sym(environment *env, const ch Line 393  void push_sym(environment *env, const ch
393      strcpy((*new_symbol)->id, in_string);      strcpy((*new_symbol)->id, in_string);
394    
395      /* Intern the new symbol in the hash table */      /* Intern the new symbol in the hash table */
396      new_value->content.ptr= *new_symbol;      new_value->content.sym= *new_symbol;
397    
398      /* Try to load the symbol name as an external function, to see if      /* Try to load the symbol name as an external function, to see if
399         we should bind the symbol to a new function pointer value */         we should bind the symbol to a new function pointer value */
# Line 1350  PROGRAMS), EVEN IF SUCH HOLDER OR OTHER Line 1350  PROGRAMS), EVEN IF SUCH HOLDER OR OTHER
1350  POSSIBILITY OF SUCH DAMAGES.\n");  POSSIBILITY OF SUCH DAMAGES.\n");
1351  }  }
1352    
 /* General assoc function */  
 void assocgen(environment *env, funcp eqfunc)  
 {  
   value *key, *item;  
   
   /* Needs two values on the stack, the top one must be an association  
      list */  
   if(env->head->type==empty || CDR(env->head)->type==empty) {  
     printerr("Too Few Arguments");  
     env->err= 1;  
     return;  
   }  
   
   if(CAR(env->head)->type!=tcons) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
     return;  
   }  
   
   key=CAR(CDR(env->head));  
   item=CAR(env->head);  
   
   while(item->type == tcons){  
     if(CAR(item)->type != tcons){  
       printerr("Bad Argument Type");  
       env->err= 2;  
       return;  
     }  
     push_val(env, key);  
     push_val(env, CAR(CAR(item)));  
     eqfunc(env); if(env->err) return;  
   
     /* Check the result of 'eqfunc' */  
     if(env->head->type==empty) {  
       printerr("Too Few Arguments");  
       env->err= 1;  
     return;  
     }  
     if(CAR(env->head)->type!=integer) {  
       printerr("Bad Argument Type");  
       env->err= 2;  
       return;  
     }  
   
     if(CAR(env->head)->content.i){  
       toss(env); if(env->err) return;  
       break;  
     }  
     toss(env); if(env->err) return;  
   
     if(item->type!=tcons) {  
       printerr("Bad Argument Type");  
       env->err= 2;  
       return;  
     }  
   
     item=CDR(item);  
   }  
   
   if(item->type == tcons){      /* A match was found */  
     push_val(env, CAR(item));  
   } else {  
     push_int(env, 0);  
   }  
   swap(env); if(env->err) return;  
   toss(env); if(env->err) return;  
   swap(env); if(env->err) return;  
   toss(env);  
 }  
   
1353  /* Discard the top element of the stack. */  /* Discard the top element of the stack. */
1354  extern void toss(environment *env)  extern void toss(environment *env)
1355  {  {
Legend:
Removed from v.1.128  
changed lines
  Added in v.1.130
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26