/[guile]/guile/guile-core/libguile/environments.c
ViewVC logotype

Diff of /guile/guile-core/libguile/environments.c

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

revision 1.27 by ttn, Thu Mar 14 03:47:41 2002 UTC revision 1.28 by xxhanwen, Sat Jul 20 14:08:33 2002 UTC
# Line 533  obarray_enter (SCM obarray, SCM symbol, Line 533  obarray_enter (SCM obarray, SCM symbol,
533    size_t hash = SCM_SYMBOL_HASH (symbol) % SCM_VECTOR_LENGTH (obarray);    size_t hash = SCM_SYMBOL_HASH (symbol) % SCM_VECTOR_LENGTH (obarray);
534    SCM entry = scm_cons (symbol, data);    SCM entry = scm_cons (symbol, data);
535    SCM slot = scm_cons (entry, SCM_VELTS (obarray)[hash]);    SCM slot = scm_cons (entry, SCM_VELTS (obarray)[hash]);
536    SCM_VELTS (obarray)[hash] = slot;    SCM_VECTOR_SET  (obarray, hash, slot);
537    
538    return entry;    return entry;
539  }  }
# Line 562  obarray_replace (SCM obarray, SCM symbol Line 562  obarray_replace (SCM obarray, SCM symbol
562      }      }
563    
564    slot = scm_cons (new_entry, SCM_VELTS (obarray)[hash]);    slot = scm_cons (new_entry, SCM_VELTS (obarray)[hash]);
565    SCM_VELTS (obarray)[hash] = slot;    SCM_VECTOR_SET (obarray, hash, slot);
566    
567    return SCM_BOOL_F;    return SCM_BOOL_F;
568  }  }
# Line 587  obarray_retrieve (SCM obarray, SCM sym) Line 587  obarray_retrieve (SCM obarray, SCM sym)
587    return SCM_UNDEFINED;    return SCM_UNDEFINED;
588  }  }
589    
590    /*
591      Remove first occurance of KEY from (cdr ALIST),
592      return (KEY . VAL) if found, otherwise return #f
593    
594      PRECONDITION:
595    
596      length (ALIST) >= 1
597     */
598    static
599    SCM
600    remove_key_from_alist (SCM alist, SCM key)
601    {
602      SCM cell_cdr = alist;
603      alist =SCM_CDR (alist);
604    
605      /*
606        inv: cdr(cell_cdr) == alist
607       */
608      while (!SCM_NULLP (alist))
609        {
610          if (SCM_EQ_P(SCM_CAAR (alist), key))
611            {
612              SCM entry = SCM_CAR(alist);
613              SCM_SETCDR(cell_cdr, SCM_CDR (alist));
614    
615              return entry;
616            }
617          else
618            {
619              cell_cdr = SCM_CDR (cell_cdr);
620            }
621          
622          if (!SCM_NULLP(alist))
623            alist = SCM_CDR (alist);
624        }
625    
626      return SCM_BOOL_F;
627    }
628    
629      
630    
631  /*  /*
632   * Remove entry from obarray.  If the symbol was found and removed, the old   * Remove entry from obarray.  If the symbol was found and removed, the old
# Line 596  static SCM Line 636  static SCM
636  obarray_remove (SCM obarray, SCM sym)  obarray_remove (SCM obarray, SCM sym)
637  {  {
638    size_t hash = SCM_SYMBOL_HASH (sym) % SCM_VECTOR_LENGTH (obarray);    size_t hash = SCM_SYMBOL_HASH (sym) % SCM_VECTOR_LENGTH (obarray);
639    SCM lsym;    SCM table_entry = SCM_VELTS (obarray)[hash];
640    SCM *lsymp;  
641      if (SCM_NULLP(table_entry))
642        return SCM_BOOL_F;
643    
644    /* Dirk:FIXME:: gc problem due to use of &SCM_VELTS[hash] */    if (SCM_EQ_P (SCM_CAAR (table_entry), sym))
   for (lsym = *(lsymp = &SCM_VELTS (obarray)[hash]);  
        !SCM_NULLP (lsym);  
        lsym = *(lsymp = SCM_CDRLOC (lsym)))  
645      {      {
646        SCM entry = SCM_CAR (lsym);        SCM_VECTOR_SET (obarray, hash, SCM_CDR(table_entry));
647        if (SCM_EQ_P (SCM_CAR (entry), sym))        return SCM_CAR(table_entry);
648          {      }
649            *lsymp = SCM_CDR (lsym);    else
650            return entry;      {
651          }        return remove_key_from_alist (table_entry, sym);
652      }      }
   return SCM_BOOL_F;  
653  }  }
654    
655    
# Line 623  obarray_remove_all (SCM obarray) Line 661  obarray_remove_all (SCM obarray)
661    
662    for (i = 0; i < size; i++)    for (i = 0; i < size; i++)
663      {      {
664        SCM_VELTS (obarray)[i] = SCM_EOL;        SCM_VECTOR_SET (obarray, i, SCM_EOL);
665      }      }
666  }  }
667    
# Line 655  struct core_environments_base { Line 693  struct core_environments_base {
693  #define CORE_ENVIRONMENT_WEAK_OBSERVERS(env) \  #define CORE_ENVIRONMENT_WEAK_OBSERVERS(env) \
694    (SCM_VELTS (CORE_ENVIRONMENT_WEAK_OBSERVER_VECTOR (env)) [0])    (SCM_VELTS (CORE_ENVIRONMENT_WEAK_OBSERVER_VECTOR (env)) [0])
695  #define SCM_SET_CORE_ENVIRONMENT_WEAK_OBSERVERS(env, v) \  #define SCM_SET_CORE_ENVIRONMENT_WEAK_OBSERVERS(env, v) \
696    (SCM_VELTS (CORE_ENVIRONMENT_WEAK_OBSERVER_VECTOR (env)) [0] = (v))    (SCM_VECTOR_SET (CORE_ENVIRONMENT_WEAK_OBSERVER_VECTOR (env), 0, (v)))
697    
698    
699    

Legend:
Removed from v.1.27  
changed lines
  Added in v.1.28

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26