/[gcl]/gcl/o/hash.d
ViewVC logotype

Diff of /gcl/o/hash.d

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

revision 1.3 by camm, Fri Jul 12 22:00:49 2002 UTC revision 1.4 by camm, Sat Jul 20 07:10:55 2002 UTC
# Line 86  object x; Line 86  object x;
86  }  }
87    
88  unsigned int  unsigned int
89  hash_equal(x,depth)  ihash_equal(x,depth)
90  object x;  object x;
91  int depth;  int depth;
92  {  {
# Line 100  BEGIN: Line 100  BEGIN:
100          if (depth++ >3) return h;          if (depth++ >3) return h;
101          switch (type_of(x)) {          switch (type_of(x)) {
102          case t_cons:          case t_cons:
103                  h += hash_equal(x->c.c_car,depth);                  h += ihash_equal(x->c.c_car,depth);
104                  x = x->c.c_cdr;                  x = x->c.c_cdr;
105                  goto BEGIN;                  goto BEGIN;
106    
# Line 151  BEGIN: Line 151  BEGIN:
151           return(h);           return(h);
152         }         }
153          case t_pathname:          case t_pathname:
154                  h += hash_equal(x->pn.pn_host,depth);                  h += ihash_equal(x->pn.pn_host,depth);
155                  h += hash_equal(x->pn.pn_device,depth);                  h += ihash_equal(x->pn.pn_device,depth);
156                  h += hash_equal(x->pn.pn_directory,depth);                  h += ihash_equal(x->pn.pn_directory,depth);
157                  h += hash_equal(x->pn.pn_name,depth);                  h += ihash_equal(x->pn.pn_name,depth);
158                  h += hash_equal(x->pn.pn_type,depth);                  h += ihash_equal(x->pn.pn_type,depth);
159                  h += hash_equal(x->pn.pn_version,depth);                  h += ihash_equal(x->pn.pn_version,depth);
160                  return(h);                  return(h);
161  /*  CLTLII says don't descend into structures  /*  CLTLII says don't descend into structures
162          case t_structure:          case t_structure:
# Line 164  BEGIN: Line 164  BEGIN:
164                   struct s_data *def;                   struct s_data *def;
165                   def=S_DATA(x->str.str_def);                   def=S_DATA(x->str.str_def);
166                   s_type= & SLOT_TYPE(x->str.str_def,0);                   s_type= & SLOT_TYPE(x->str.str_def,0);
167                   h += hash_equal(def->name,depth);                   h += ihash_equal(def->name,depth);
168                   for (i = 0;  i < def->length;  i++)                   for (i = 0;  i < def->length;  i++)
169                     if (s_type[i]==0)                     if (s_type[i]==0)
170                       h += hash_equal(x->str.str_self[i],depth);                       h += ihash_equal(x->str.str_self[i],depth);
171                     else                     else
172                       h += ((int)x->str.str_self[i]) + depth++;                       h += ((int)x->str.str_self[i]) + depth++;
173                   return(h);}                   return(h);}
# Line 178  BEGIN: Line 178  BEGIN:
178          }          }
179  }  }
180                                    
181    object
182    hash_equal(x,depth)
183    object x;
184    int depth;
185    {
186    
187            return make_fixnum(ihash_equal(x,length));
188    
189    }
190    
191  struct htent *  struct htent *
192  gethash(key, hashtable)  gethash(key, hashtable)
193  object key;  object key;
# Line 187  object hashtable; Line 197  object hashtable;
197          int hsize;          int hsize;
198          struct htent *e;          struct htent *e;
199          object hkey;          object hkey;
200          int i, j = -1, k; /* k added by chou */          int i=0, j = -1, k; /* k added by chou */
201          bool b;          bool b=FALSE;
202    
203          htest = (enum httest)hashtable->ht.ht_test;          htest = (enum httest)hashtable->ht.ht_test;
204          hsize = hashtable->ht.ht_size;          hsize = hashtable->ht.ht_size;
# Line 197  object hashtable; Line 207  object hashtable;
207          else if (htest == htt_eql)          else if (htest == htt_eql)
208                  i = hash_eql(key);                  i = hash_eql(key);
209          else if (htest == htt_equal)          else if (htest == htt_equal)
210                  i = hash_equal(key,0);                  i = ihash_equal(key,0);
211          i &= 0x7fffffff;          i &= 0x7fffffff;
212          for (i %= hsize, k = 0; k < hsize;  i = (i + 1) % hsize, k++) { /* k added by chou */          for (i %= hsize, k = 0; k < hsize;  i = (i + 1) % hsize, k++) { /* k added by chou */
213                  e = &hashtable->ht.ht_self[i];                  e = &hashtable->ht.ht_self[i];
# Line 230  object hashtable; Line 240  object hashtable;
240          return(&hashtable->ht.ht_self[j]);      /* added by chou */          return(&hashtable->ht.ht_self[j]);      /* added by chou */
241  }  }
242    
243    void
244    extend_hashtable(object);
245    
246    void
247  sethash(key, hashtable, value)  sethash(key, hashtable, value)
248  object key, hashtable, value;  object key, hashtable, value;
249  {  {
250          int i;          int i;
251          bool over;          bool over=FALSE;
252          struct htent *e;          struct htent *e;
253                    
254          i = hashtable->ht.ht_nent + 1;          i = hashtable->ht.ht_nent + 1;
# Line 255  object key, hashtable, value; Line 269  object key, hashtable, value;
269          e->hte_value = value;          e->hte_value = value;
270  }  }
271                    
272    void
273  extend_hashtable(hashtable)  extend_hashtable(hashtable)
274  object hashtable;  object hashtable;
275  {  {
276          object old;          object old;
277          int new_size, i;          int new_size=0, i;
278    
279          if (type_of(hashtable->ht.ht_rhsize) == t_fixnum)          if (type_of(hashtable->ht.ht_rhsize) == t_fixnum)
280                  new_size =                  new_size =
# Line 293  object hashtable; Line 308  object hashtable;
308                                  old->ht.ht_self[i].hte_value);                                  old->ht.ht_self[i].hte_value);
309          }          }
310          hashtable->ht.ht_nent = old->ht.ht_nent;          hashtable->ht.ht_nent = old->ht.ht_nent;
311          vs_pop;          vs_popp;
312          END_NO_INTERRUPT;}          END_NO_INTERRUPT;}
313  }  }
314    
# Line 305  object hashtable; Line 320  object hashtable;
320                                (rehash_threshold                                (rehash_threshold
321                                 `make_shortfloat((shortfloat)0.7)`)                                 `make_shortfloat((shortfloat)0.7)`)
322                           &aux h)                           &aux h)
323          enum httest htt;          enum httest htt=0;
324          int i;          int i;
325  @  @
326          if (test == sLeq || test == sLeq->s.s_gfdef)          if (test == sLeq || test == sLeq->s.s_gfdef)
# Line 321  object hashtable; Line 336  object hashtable;
336                  ;                  ;
337          else          else
338                  FEerror("~S is an illegal hash-table size.", 1, size);                  FEerror("~S is an illegal hash-table size.", 1, size);
339          if (type_of(rehash_size) == t_fixnum && 0 < fix(rehash_size) ||          if ((type_of(rehash_size) == t_fixnum && 0 < fix(rehash_size)) ||
340              type_of(rehash_size) == t_shortfloat && 1.0 < sf(rehash_size) ||              (type_of(rehash_size) == t_shortfloat && 1.0 < sf(rehash_size)) ||
341              type_of(rehash_size) == t_longfloat && 1.0 < lf(rehash_size))              (type_of(rehash_size) == t_longfloat && 1.0 < lf(rehash_size)))
342                  ;                  ;
343          else          else
344                  FEerror("~S is an illegal hash-table rehash-size.",                  FEerror("~S is an illegal hash-table rehash-size.",
345                          1, rehash_size);                          1, rehash_size);
346          if (type_of(rehash_threshold) == t_fixnum &&          if ((type_of(rehash_threshold) == t_fixnum &&
347              0 < fix(rehash_threshold) && fix(rehash_threshold) < fix(size) ||              0 < fix(rehash_threshold) && fix(rehash_threshold) < fix(size)) ||
348              type_of(rehash_threshold) == t_shortfloat &&              (type_of(rehash_threshold) == t_shortfloat &&
349              0.0 < sf(rehash_threshold) && sf(rehash_threshold) < 1.0 ||              0.0 < sf(rehash_threshold) && sf(rehash_threshold) < 1.0) ||
350              type_of(rehash_threshold) == t_longfloat &&              (type_of(rehash_threshold) == t_longfloat &&
351              0.0 < lf(rehash_threshold) && lf(rehash_threshold) < 1.0)              0.0 < lf(rehash_threshold) && lf(rehash_threshold) < 1.0))
352                  ;                  ;
353          else          else
354                  FEerror("~S is an illegal hash-table rehash-threshold.",                  FEerror("~S is an illegal hash-table rehash-threshold.",
# Line 356  object hashtable; Line 371  object hashtable;
371          @(return h)          @(return h)
372  @)  @)
373    
374    void
375  Lhash_table_p()  Lhash_table_p()
376  {  {
377          check_arg(1);          check_arg(1);
# Line 366  Lhash_table_p() Line 382  Lhash_table_p()
382                  vs_base[0] = Cnil;                  vs_base[0] = Cnil;
383  }  }
384    
385    void
386  Lgethash()  Lgethash()
387  {  {
388          int narg;          int narg;
# Line 387  Lgethash() Line 404  Lgethash()
404                  vs_base[0] = vs_base[2];                  vs_base[0] = vs_base[2];
405                  vs_base[1] = Cnil;                  vs_base[1] = Cnil;
406          }          }
407          vs_pop;          vs_popp;
408  }  }
409    
410    void
411  siLhash_set()  siLhash_set()
412  {  {
413          check_arg(3);          check_arg(3);
# Line 399  siLhash_set() Line 417  siLhash_set()
417          vs_base += 2;          vs_base += 2;
418  }  }
419                    
420    void
421  Lremhash()  Lremhash()
422  {  {
423          struct htent *e;          struct htent *e;
# Line 416  Lremhash() Line 435  Lremhash()
435          vs_top = vs_base + 1;          vs_top = vs_base + 1;
436  }  }
437    
438    void
439  Lclrhash()  Lclrhash()
440  {  {
441          int i;          int i;
# Line 429  Lclrhash() Line 449  Lclrhash()
449          vs_base[0]->ht.ht_nent = 0;          vs_base[0]->ht.ht_nent = 0;
450  }  }
451    
452    void
453  Lhash_table_count()  Lhash_table_count()
454  {  {
         object z;  
455    
456          check_arg(1);          check_arg(1);
457          check_type_hash_table(&vs_base[0]);          check_type_hash_table(&vs_base[0]);
# Line 439  Lhash_table_count() Line 459  Lhash_table_count()
459  }  }
460    
461    
462    void
463  Lsxhash()  Lsxhash()
464  {  {
465          check_arg(1);          check_arg(1);
466    
467          vs_base[0] = make_fixnum(hash_equal(vs_base[0],0) & 0x7fffffff);          vs_base[0] = make_fixnum(ihash_equal(vs_base[0],0) & 0x7fffffff);
468  }  }
469    
470    void
471  Lmaphash()  Lmaphash()
472  {  {
473          object *base = vs_base;          object *base = vs_base;
# Line 462  Lmaphash() Line 484  Lmaphash()
484                                    hashtable->ht.ht_self[i].hte_value);                                    hashtable->ht.ht_self[i].hte_value);
485          }          }
486          vs_base[0] = Cnil;          vs_base[0] = Cnil;
487          vs_pop;          vs_popp;
488  }  }
489    
490  DEFUN("NEXT-HASH-TABLE-ENTRY",object,fSnext_hash_table_entry,SI,2,2,NONE,OO,OO,OO,OO,"For HASH-TABLE and for index I return three values: NEXT-START, the next KEY and its  VALUE.   NEXT-START will be -1 if there are no more entries, otherwise it will be a value suitable for passing as an index")  DEFUN("NEXT-HASH-TABLE-ENTRY",object,fSnext_hash_table_entry,SI,2,2,NONE,OO,OO,OO,OO,"For HASH-TABLE and for index I return three values: NEXT-START, the next KEY and its  VALUE.   NEXT-START will be -1 if there are no more entries, otherwise it will be a value suitable for passing as an index")
# Line 493  object table; Line 515  object table;
515    RETURN1(sLnil);    RETURN1(sLnil);
516  }  }
517    
518  DEFUN("HASH-TABLE-SIZE",int,fLhash_table_size,LISP,1,1,NONE,IO,OO,OO,OO,"")  DEFUN("HASH-TABLE-SIZE",object,fLhash_table_size,LISP,1,1,NONE,IO,OO,OO,OO,"")
519  (table)  (table)
520  object table;  object table;
521  {  {
522    RETURN1(table->ht.ht_size);    RETURN1(make_fixnum(table->ht.ht_size));
523    
524  }  }
525    
526    
527    
528    void
529  init_hash()  init_hash()
530  {  {
531          sLeq = make_ordinary("EQ");          sLeq = make_ordinary("EQ");

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

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