fix iteration on large hash trees

Bug introduced by 7a8c2ff063: a tree can be deep enough that the
representation of the path to the current item can be too big to
fit into 32 bits. It will always fit in 64 bits, though.

Merge to 5.3.4
(cherry picked from commit f09d1d1ae8)

Conflicts:
	src/racket/src/string.c

collects/tests/racket/basic.rktl

@@ -2554,6 +2554,36 @@
   (set-a-y! an-a 8)
   (test v equal-hash-code an-a))
 
+
+;; Try to build a hash table whose indexes fonr't fit in 32 bits:
+(let ()
+  (struct a (x)
+    #:property 
+    prop:equal+hash
+    (list
+     (lambda (a b eql?) (eql? (a-x a) (a-x b)))
+     (lambda (a hash) (expt 2 15))
+     (lambda (b hash) 1)))
+  
+
+  (define (same-ish i) (a i))
+
+  ;; No collisions: min depth 17, tree might be as
+  ;; deep as 1.44 * 17 = 24
+  (define ht (for/hash ([i (in-range (expt 2 17))])
+               (values i i)))
+
+  ;; All collissions: subtree min depth is 11, might
+  ;; be as deep as 1.44*11 = 15
+  (define ht2 (for/fold ([ht ht]) ([i (in-range (expt 2 11))])
+                (hash-set ht (same-ish i) i)))
+
+  ;; `ht2' depth is between 28 and 39
+
+  ;; If the indexes go bad, this loop fails:
+  (for ([(k v) (in-hash ht2)])
+    v))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Misc
 

src/racket/src/hash.c

@@ -2451,7 +2451,7 @@ Scheme_Object *scheme_hash_tree_get(Scheme_Hash_Tree *tree, Scheme_Object *key)
   return NULL;
 }
 
-XFORM_NONGCING intptr_t path_next(AVLNode *avl, intptr_t path)
+XFORM_NONGCING mzlonglong path_next(AVLNode *avl, mzlonglong path)
 {
   if (!avl)
     return -1;
@@ -2500,7 +2500,7 @@ XFORM_NONGCING intptr_t path_next(AVLNode *avl, intptr_t path)
   }
 }
 
-XFORM_NONGCING int path_find(AVLNode *avl, intptr_t path, Scheme_Object **_key, Scheme_Object **_val)
+XFORM_NONGCING int path_find(AVLNode *avl, mzlonglong path, Scheme_Object **_key, Scheme_Object **_val)
 {
   if (!avl) return 0;
 
@@ -2531,13 +2531,13 @@ XFORM_NONGCING int path_find(AVLNode *avl, intptr_t path, Scheme_Object **_key,
     return path_find(avl->left, path >> 1, _key, _val);
 }
 
-intptr_t scheme_hash_tree_next(Scheme_Hash_Tree *tree, intptr_t pos)
+mzlonglong scheme_hash_tree_next(Scheme_Hash_Tree *tree, mzlonglong pos)
 {
   /* Iteration uses a key where the bits say when to turn right */
   return path_next(tree->root, ((pos == -1) ? 0 : pos));
 }
 
-int scheme_hash_tree_index(Scheme_Hash_Tree *tree, intptr_t pos, Scheme_Object **_key, Scheme_Object **_val)
+int scheme_hash_tree_index(Scheme_Hash_Tree *tree, mzlonglong pos, Scheme_Object **_key, Scheme_Object **_val)
 {
   return path_find(tree->root, pos, _key, _val);
 }

src/racket/src/list.c

@@ -2145,7 +2145,7 @@ static Scheme_Object *hash_table_copy(int argc, Scheme_Object *argv[])
   } else if (SCHEME_HASHTRP(v)) {
     Scheme_Hash_Tree *t;
     Scheme_Hash_Table *naya;
-    int i;
+    mzlonglong i;
     Scheme_Object *k, *val;
 
     if (SCHEME_NP_CHAPERONEP(v))
@@ -2576,7 +2576,7 @@ static Scheme_Object *do_map_hash_table(int argc,
   } else {
     Scheme_Object *ik, *iv;
     Scheme_Hash_Tree *hash;
-    intptr_t pos;
+    mzlonglong pos;
 
     hash = (Scheme_Hash_Tree *)obj;
 
@@ -2620,7 +2620,7 @@ static Scheme_Object *hash_table_for_each(int argc, Scheme_Object *argv[])
   return do_map_hash_table(argc, argv, "hash-for-each", 0);
 }
 
-static Scheme_Object *hash_table_next(const char *name, int start, int argc, Scheme_Object *argv[])
+static Scheme_Object *hash_table_next(const char *name, mzlonglong start, int argc, Scheme_Object *argv[])
 {
   Scheme_Object *o = argv[0];
 
@@ -2645,14 +2645,14 @@ static Scheme_Object *hash_table_next(const char *name, int start, int argc, Sch
 
     return scheme_false;
   } else if (SCHEME_HASHTRP(o)) {
-    int v;
+    mzlonglong v;
     v = scheme_hash_tree_next((Scheme_Hash_Tree *)o, start);
     if (v == -1)
       return scheme_false;
     else if (v == -2)
       return NULL;
     else
-      return scheme_make_integer(v);
+      return scheme_make_integer_value_from_long_long(v);
   } else if (SCHEME_BUCKTP(o)) {
     Scheme_Bucket_Table *hash;
     Scheme_Bucket *bucket;
@@ -2686,18 +2686,17 @@ Scheme_Object *scheme_hash_table_iterate_start(int argc, Scheme_Object *argv[])
   return hash_table_next("hash-iterate-first", -1, argc, argv);
 }
 
+#define HASH_POS_TOO_BIG ((mzlonglong)1) << 62
+
 Scheme_Object *scheme_hash_table_iterate_next(int argc, Scheme_Object *argv[])
 {
   Scheme_Object *p = argv[1], *v;
-  int pos;
+  mzlonglong pos;
 
-  if (SCHEME_INTP(p)) {
+  if (!scheme_get_long_long_val(p, &pos))
-    pos = SCHEME_INT_VAL(p);
+    pos = HASH_POS_TOO_BIG;
-    if (pos < 0)
+  else if (pos < 0)
-      pos = 0x7FFFFFFE;
+    pos = HASH_POS_TOO_BIG;
-  } else {
-    pos = 0x7FFFFFFE;
-  }
 
   v = hash_table_next("hash-iterate-next", pos, argc, argv);
 
@@ -2725,7 +2724,8 @@ Scheme_Object *scheme_hash_table_iterate_next(int argc, Scheme_Object *argv[])
 static Scheme_Object *hash_table_index(const char *name, int argc, Scheme_Object *argv[], int get_val)
 {
   Scheme_Object *p = argv[1], *obj, *chaperone, *key;
-  int pos, sz;
+  mzlonglong pos;
+  intptr_t sz;
 
   obj = argv[0];
   if (SCHEME_NP_CHAPERONEP(obj)) {
@@ -2734,13 +2734,10 @@ static Scheme_Object *hash_table_index(const char *name, int argc, Scheme_Object
   } else
     chaperone = NULL;
 
-  if (SCHEME_INTP(p)) {
+  if (!scheme_get_long_long_val(p, &pos))
-    pos = SCHEME_INT_VAL(p);
+    pos = HASH_POS_TOO_BIG;
-    if (pos < 0)
+  else if (pos < 0)
-      pos = 0x7FFFFFFF;
+    pos = HASH_POS_TOO_BIG;
-  } else {
-    pos = 0x7FFFFFFF;
-  }
 
   if (SCHEME_HASHTP(obj)) {
     Scheme_Hash_Table *hash;
@@ -2782,7 +2779,6 @@ static Scheme_Object *hash_table_index(const char *name, int argc, Scheme_Object
     }
   } else if (SCHEME_BUCKTP(obj)) {
     Scheme_Bucket_Table *hash;
-    int sz;
     Scheme_Bucket *bucket;
 
     hash = (Scheme_Bucket_Table *)obj;

src/racket/src/print.c

@@ -679,7 +679,7 @@ static int check_cycles(Scheme_Object *obj, int for_write, Scheme_Hash_Table *ht
     /* got here => printable */
     Scheme_Hash_Tree *t;
     Scheme_Object *key, *val;
-    int i;
+    mzlonglong i;
 
     if (SCHEME_NP_CHAPERONEP(obj))
       t = (Scheme_Hash_Tree *)SCHEME_CHAPERONE_VAL(obj);
@@ -949,7 +949,7 @@ static void setup_graph_table(Scheme_Object *obj, int for_write, Scheme_Hash_Tab
     /* got here => printable */
     Scheme_Hash_Tree *t;
     Scheme_Object *key, *val;
-    int i;
+    mzlonglong i;
 
     if (SCHEME_NP_CHAPERONEP(obj))
       t = (Scheme_Hash_Tree *)SCHEME_CHAPERONE_VAL(obj);
@@ -2301,7 +2301,9 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
       Scheme_Hash_Table *t;
       Scheme_Hash_Tree *tr;
       Scheme_Object **keys, **vals, *val, *key, *orig;
-      int i, size, did_one = 0, pos;
+      intptr_t i, size;
+      int did_one = 0;
+      mzlonglong pos;
 
       orig = obj;
       if (SCHEME_NP_CHAPERONEP(obj))

src/racket/src/read.c

@@ -2173,7 +2173,7 @@ static Scheme_Object *resolve_references(Scheme_Object *obj,
       obj = scheme_chaperone_hash_table_copy(obj);
 
     if (SCHEME_HASHTRP(obj)) {
-      int i;
+      mzlonglong i;
       if (scheme_is_hash_tree_equal(obj))
         kind = 1;
       else if (scheme_is_hash_tree_eqv(obj))

src/racket/src/schemef.h

@@ -507,8 +507,8 @@ MZ_EXTERN Scheme_Hash_Tree *scheme_make_hash_tree(int kind);
 MZ_EXTERN Scheme_Hash_Tree *scheme_hash_tree_set(Scheme_Hash_Tree *tree, Scheme_Object *key, Scheme_Object *val);
 MZ_EXTERN Scheme_Object *scheme_hash_tree_get(Scheme_Hash_Tree *tree, Scheme_Object *key);
 XFORM_NONGCING MZ_EXTERN Scheme_Object *scheme_eq_hash_tree_get(Scheme_Hash_Tree *tree, Scheme_Object *key);
-XFORM_NONGCING MZ_EXTERN intptr_t scheme_hash_tree_next(Scheme_Hash_Tree *tree, intptr_t pos);
+XFORM_NONGCING MZ_EXTERN mzlonglong scheme_hash_tree_next(Scheme_Hash_Tree *tree, mzlonglong pos);
-XFORM_NONGCING MZ_EXTERN int scheme_hash_tree_index(Scheme_Hash_Tree *tree, intptr_t pos, Scheme_Object **_key, Scheme_Object **_val);
+XFORM_NONGCING MZ_EXTERN int scheme_hash_tree_index(Scheme_Hash_Tree *tree, mzlonglong pos, Scheme_Object **_key, Scheme_Object **_val);
 MZ_EXTERN int scheme_hash_tree_equal(Scheme_Hash_Tree *t1, Scheme_Hash_Tree *t2);
 MZ_EXTERN int scheme_is_hash_tree_equal(Scheme_Object *o);
 MZ_EXTERN int scheme_is_hash_tree_eqv(Scheme_Object *o);

src/racket/src/schemex.h

@@ -399,8 +399,8 @@ Scheme_Hash_Tree *(*scheme_make_hash_tree)(int kind);
 Scheme_Hash_Tree *(*scheme_hash_tree_set)(Scheme_Hash_Tree *tree, Scheme_Object *key, Scheme_Object *val);
 Scheme_Object *(*scheme_hash_tree_get)(Scheme_Hash_Tree *tree, Scheme_Object *key);
 Scheme_Object *(*scheme_eq_hash_tree_get)(Scheme_Hash_Tree *tree, Scheme_Object *key);
-intptr_t (*scheme_hash_tree_next)(Scheme_Hash_Tree *tree, intptr_t pos);
+mzlonglong (*scheme_hash_tree_next)(Scheme_Hash_Tree *tree, mzlonglong pos);
-int (*scheme_hash_tree_index)(Scheme_Hash_Tree *tree, intptr_t pos, Scheme_Object **_key, Scheme_Object **_val);
+int (*scheme_hash_tree_index)(Scheme_Hash_Tree *tree, mzlonglong pos, Scheme_Object **_key, Scheme_Object **_val);
 int (*scheme_hash_tree_equal)(Scheme_Hash_Tree *t1, Scheme_Hash_Tree *t2);
 int (*scheme_is_hash_tree_equal)(Scheme_Object *o);
 int (*scheme_is_hash_tree_eqv)(Scheme_Object *o);

src/racket/src/syntax.c

@@ -2879,7 +2879,7 @@ static Scheme_Object *stx_content(Scheme_Object *o, int add_taint, int keep)
     } else if (SCHEME_HASHTRP(v)) {
       Scheme_Hash_Tree *ht = (Scheme_Hash_Tree *)v, *ht2;
       Scheme_Object *key, *val;
-      int i;
+      mzlonglong i;
 
       ht2 = scheme_make_hash_tree(SCHEME_HASHTR_FLAGS(ht) & 0x3);
 
@@ -6753,7 +6753,7 @@ static Scheme_Object *syntax_to_datum_inner(Scheme_Object *o,
   } else if (SCHEME_HASHTRP(v)) {
     Scheme_Hash_Tree *ht = (Scheme_Hash_Tree *)v, *ht2;
     Scheme_Object *key, *val;
-    int i;
+    mzlonglong i;
     
     ht2 = scheme_make_hash_tree(SCHEME_HASHTR_FLAGS(ht) & 0x3);
     
@@ -7636,7 +7636,7 @@ static Scheme_Object *datum_to_syntax_inner(Scheme_Object *o,
   } else if (SCHEME_CHAPERONE_HASHTRP(o)) {
     Scheme_Hash_Tree *ht1, *ht2;
     Scheme_Object *key, *val;
-    int i;
+    mzlonglong i;
 
     if (SCHEME_NP_CHAPERONEP(o))
       ht1 = (Scheme_Hash_Tree *)SCHEME_CHAPERONE_VAL(o);
@@ -7889,7 +7889,7 @@ static void simplify_syntax_inner(Scheme_Object *o,
   } else if (SCHEME_HASHTRP(v)) {
     Scheme_Hash_Tree *ht = (Scheme_Hash_Tree *)v;
     Scheme_Object *key, *val;
-    int i;
+    mzlonglong i;
     
     i = scheme_hash_tree_next(ht, -1);
     while (i != -1) {