From: simonmar <unknown>
Date: Fri, 8 Oct 2004 10:28:37 +0000 (+0000)
Subject: [project @ 2004-10-08 10:28:37 by simonmar]
X-Git-Tag: nhc98-1-18-release~221
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=d0050b1bea9bb8ede55ed360ec5fb7131d195e0c;p=ghc-base.git

[project @ 2004-10-08 10:28:37 by simonmar]
- make sure we don't overflow the table
- use a checked array index just in case we *do* try to overflow
- fix a harmless off-by-one
---

diff --git a/Data/HashTable.hs b/Data/HashTable.hs
index b392ce2..39fc93c 100644
--- a/Data/HashTable.hs
+++ b/Data/HashTable.hs
@@ -187,7 +187,7 @@ new
 
 new cmp hash_fn = do
   -- make a new hash table with a single, empty, segment
-  dir     <- newIOArray (0,dIR_SIZE) undefined
+  dir     <- newIOArray (0,dIR_SIZE-1) undefined
   segment <- newIOArray (0,sEGMENT_SIZE-1) []
   myWriteArray dir 0 segment
 
@@ -271,9 +271,15 @@ expandHashTable
       newsegment = newbucket `shiftR` sEGMENT_SHIFT
       newindex   = newbucket .&. sEGMENT_MASK
   --
+  if newsegment >= dIR_SIZE	-- make sure we don't overflow the table.
+	then return table
+	else do
+  --
   when (newindex == 0) $
 	do segment <- newIOArray (0,sEGMENT_SIZE-1) []
-	   myWriteArray dir newsegment segment
+	   writeIOArray dir newsegment segment
+	   -- doesn't happen very often, so we might as well use a safe
+	   -- array index here.
   --
   let table' =
   	if (split+1) < max