- initial import of revision 374 from cnc
[apt.git] / lua / ltable.c
1 /*
2 ** $Id: ltable.c,v 1.132 2003/04/03 13:35:34 roberto Exp $
3 ** Lua tables (hash)
4 ** See Copyright Notice in lua.h
5 */
6
7
8 /*
9 ** Implementation of tables (aka arrays, objects, or hash tables).
10 ** Tables keep its elements in two parts: an array part and a hash part.
11 ** Non-negative integer keys are all candidates to be kept in the array
12 ** part. The actual size of the array is the largest `n' such that at
13 ** least half the slots between 0 and n are in use.
14 ** Hash uses a mix of chained scatter table with Brent's variation.
15 ** A main invariant of these tables is that, if an element is not
16 ** in its main position (i.e. the `original' position that its hash gives
17 ** to it), then the colliding element is in its own main position.
18 ** In other words, there are collisions only when two elements have the
19 ** same main position (i.e. the same hash values for that table size).
20 ** Because of that, the load factor of these tables can be 100% without
21 ** performance penalties.
22 */
23
24 #include <string.h>
25
26 #define ltable_c
27
28 #include "lua.h"
29
30 #include "ldebug.h"
31 #include "ldo.h"
32 #include "lgc.h"
33 #include "lmem.h"
34 #include "lobject.h"
35 #include "lstate.h"
36 #include "ltable.h"
37
38
39 /*
40 ** max size of array part is 2^MAXBITS
41 */
42 #if BITS_INT > 26
43 #define MAXBITS         24
44 #else
45 #define MAXBITS         (BITS_INT-2)
46 #endif
47
48 /* check whether `x' < 2^MAXBITS */
49 #define toobig(x)       ((((x)-1) >> MAXBITS) != 0)
50
51
52 /* function to convert a lua_Number to int (with any rounding method) */
53 #ifndef lua_number2int
54 #define lua_number2int(i,n)     ((i)=(int)(n))
55 #endif
56
57
58 #define hashpow2(t,n)      (gnode(t, lmod((n), sizenode(t))))
59   
60 #define hashstr(t,str)  hashpow2(t, (str)->tsv.hash)
61 #define hashboolean(t,p)        hashpow2(t, p)
62
63
64 /*
65 ** for some types, it is better to avoid modulus by power of 2, as
66 ** they tend to have many 2 factors.
67 */
68 #define hashmod(t,n)    (gnode(t, ((n) % ((sizenode(t)-1)|1))))
69
70
71 #define hashpointer(t,p)        hashmod(t, IntPoint(p))
72
73
74 /*
75 ** number of ints inside a lua_Number
76 */
77 #define numints         cast(int, sizeof(lua_Number)/sizeof(int))
78
79
80 /*
81 ** hash for lua_Numbers
82 */
83 static Node *hashnum (const Table *t, lua_Number n) {
84   unsigned int a[numints];
85   int i;
86   n += 1;  /* normalize number (avoid -0) */
87   lua_assert(sizeof(a) <= sizeof(n));
88   memcpy(a, &n, sizeof(a));
89   for (i = 1; i < numints; i++) a[0] += a[i];
90   return hashmod(t, cast(lu_hash, a[0]));
91 }
92
93
94
95 /*
96 ** returns the `main' position of an element in a table (that is, the index
97 ** of its hash value)
98 */
99 Node *luaH_mainposition (const Table *t, const TObject *key) {
100   switch (ttype(key)) {
101     case LUA_TNUMBER:
102       return hashnum(t, nvalue(key));
103     case LUA_TSTRING:
104       return hashstr(t, tsvalue(key));
105     case LUA_TBOOLEAN:
106       return hashboolean(t, bvalue(key));
107     case LUA_TLIGHTUSERDATA:
108       return hashpointer(t, pvalue(key));
109     default:
110       return hashpointer(t, gcvalue(key));
111   }
112 }
113
114
115 /*
116 ** returns the index for `key' if `key' is an appropriate key to live in
117 ** the array part of the table, -1 otherwise.
118 */
119 static int arrayindex (const TObject *key) {
120   if (ttisnumber(key)) {
121     int k;
122     lua_number2int(k, (nvalue(key)));
123     if (cast(lua_Number, k) == nvalue(key) && k >= 1 && !toobig(k))
124       return k;
125   }
126   return -1;  /* `key' did not match some condition */
127 }
128
129
130 /*
131 ** returns the index of a `key' for table traversals. First goes all
132 ** elements in the array part, then elements in the hash part. The
133 ** beginning and end of a traversal are signalled by -1.
134 */
135 static int luaH_index (lua_State *L, Table *t, StkId key) {
136   int i;
137   if (ttisnil(key)) return -1;  /* first iteration */
138   i = arrayindex(key);
139   if (0 <= i && i <= t->sizearray) {  /* is `key' inside array part? */
140     return i-1;  /* yes; that's the index (corrected to C) */
141   }
142   else {
143     const TObject *v = luaH_get(t, key);
144     if (v == &luaO_nilobject)
145       luaG_runerror(L, "invalid key for `next'");
146     i = cast(int, (cast(const lu_byte *, v) -
147                    cast(const lu_byte *, gval(gnode(t, 0)))) / sizeof(Node));
148     return i + t->sizearray;  /* hash elements are numbered after array ones */
149   }
150 }
151
152
153 int luaH_next (lua_State *L, Table *t, StkId key) {
154   int i = luaH_index(L, t, key);  /* find original element */
155   for (i++; i < t->sizearray; i++) {  /* try first array part */
156     if (!ttisnil(&t->array[i])) {  /* a non-nil value? */
157       setnvalue(key, cast(lua_Number, i+1));
158       setobj2s(key+1, &t->array[i]);
159       return 1;
160     }
161   }
162   for (i -= t->sizearray; i < sizenode(t); i++) {  /* then hash part */
163     if (!ttisnil(gval(gnode(t, i)))) {  /* a non-nil value? */
164       setobj2s(key, gkey(gnode(t, i)));
165       setobj2s(key+1, gval(gnode(t, i)));
166       return 1;
167     }
168   }
169   return 0;  /* no more elements */
170 }
171
172
173 /*
174 ** {=============================================================
175 ** Rehash
176 ** ==============================================================
177 */
178
179
180 static void computesizes  (int nums[], int ntotal, int *narray, int *nhash) {
181   int i;
182   int a = nums[0];  /* number of elements smaller than 2^i */
183   int na = a;  /* number of elements to go to array part */
184   int n = (na == 0) ? -1 : 0;  /* (log of) optimal size for array part */
185   for (i = 1; a < *narray && *narray >= twoto(i-1); i++) {
186     if (nums[i] > 0) {
187       a += nums[i];
188       if (a >= twoto(i-1)) {  /* more than half elements in use? */
189         n = i;
190         na = a;
191       }
192     }
193   }
194   lua_assert(na <= *narray && *narray <= ntotal);
195   *nhash = ntotal - na;
196   *narray = (n == -1) ? 0 : twoto(n);
197   lua_assert(na <= *narray && na >= *narray/2);
198 }
199
200
201 static void numuse (const Table *t, int *narray, int *nhash) {
202   int nums[MAXBITS+1];
203   int i, lg;
204   int totaluse = 0;
205   /* count elements in array part */
206   for (i=0, lg=0; lg<=MAXBITS; lg++) {  /* for each slice [2^(lg-1) to 2^lg) */
207     int ttlg = twoto(lg);  /* 2^lg */
208     if (ttlg > t->sizearray) {
209       ttlg = t->sizearray;
210       if (i >= ttlg) break;
211     }
212     nums[lg] = 0;
213     for (; i<ttlg; i++) {
214       if (!ttisnil(&t->array[i])) {
215         nums[lg]++;
216         totaluse++;
217       }
218     }
219   }
220   for (; lg<=MAXBITS; lg++) nums[lg] = 0;  /* reset other counts */
221   *narray = totaluse;  /* all previous uses were in array part */
222   /* count elements in hash part */
223   i = sizenode(t);
224   while (i--) {
225     Node *n = &t->node[i];
226     if (!ttisnil(gval(n))) {
227       int k = arrayindex(gkey(n));
228       if (k >= 0) {  /* is `key' an appropriate array index? */
229         nums[luaO_log2(k-1)+1]++;  /* count as such */
230         (*narray)++;
231       }
232       totaluse++;
233     }
234   }
235   computesizes(nums, totaluse, narray, nhash);
236 }
237
238
239 static void setarrayvector (lua_State *L, Table *t, int size) {
240   int i;
241   luaM_reallocvector(L, t->array, t->sizearray, size, TObject);
242   for (i=t->sizearray; i<size; i++)
243      setnilvalue(&t->array[i]);
244   t->sizearray = size;
245 }
246
247
248 static void setnodevector (lua_State *L, Table *t, int lsize) {
249   int i;
250   int size = twoto(lsize);
251   if (lsize > MAXBITS)
252     luaG_runerror(L, "table overflow");
253   if (lsize == 0) {  /* no elements to hash part? */
254     t->node = G(L)->dummynode;  /* use common `dummynode' */
255     lua_assert(ttisnil(gkey(t->node)));  /* assert invariants: */
256     lua_assert(ttisnil(gval(t->node)));
257     lua_assert(t->node->next == NULL);  /* (`dummynode' must be empty) */
258   }
259   else {
260     t->node = luaM_newvector(L, size, Node);
261     for (i=0; i<size; i++) {
262       t->node[i].next = NULL;
263       setnilvalue(gkey(gnode(t, i)));
264       setnilvalue(gval(gnode(t, i)));
265     }
266   }
267   t->lsizenode = cast(lu_byte, lsize);
268   t->firstfree = gnode(t, size-1);  /* first free position to be used */
269 }
270
271
272 static void resize (lua_State *L, Table *t, int nasize, int nhsize) {
273   int i;
274   int oldasize = t->sizearray;
275   int oldhsize = t->lsizenode;
276   Node *nold;
277   Node temp[1];
278   if (oldhsize)
279     nold = t->node;  /* save old hash ... */
280   else {  /* old hash is `dummynode' */
281     lua_assert(t->node == G(L)->dummynode);
282     temp[0] = t->node[0];  /* copy it to `temp' */
283     nold = temp;
284     setnilvalue(gkey(G(L)->dummynode));  /* restate invariant */
285     setnilvalue(gval(G(L)->dummynode));
286     lua_assert(G(L)->dummynode->next == NULL);
287   }
288   if (nasize > oldasize)  /* array part must grow? */
289     setarrayvector(L, t, nasize);
290   /* create new hash part with appropriate size */
291   setnodevector(L, t, nhsize);  
292   /* re-insert elements */
293   if (nasize < oldasize) {  /* array part must shrink? */
294     t->sizearray = nasize;
295     /* re-insert elements from vanishing slice */
296     for (i=nasize; i<oldasize; i++) {
297       if (!ttisnil(&t->array[i]))
298         setobjt2t(luaH_setnum(L, t, i+1), &t->array[i]);
299     }
300     /* shrink array */
301     luaM_reallocvector(L, t->array, oldasize, nasize, TObject);
302   }
303   /* re-insert elements in hash part */
304   for (i = twoto(oldhsize) - 1; i >= 0; i--) {
305     Node *old = nold+i;
306     if (!ttisnil(gval(old)))
307       setobjt2t(luaH_set(L, t, gkey(old)), gval(old));
308   }
309   if (oldhsize)
310     luaM_freearray(L, nold, twoto(oldhsize), Node);  /* free old array */
311 }
312
313
314 static void rehash (lua_State *L, Table *t) {
315   int nasize, nhsize;
316   numuse(t, &nasize, &nhsize);  /* compute new sizes for array and hash parts */
317   resize(L, t, nasize, luaO_log2(nhsize)+1);
318 }
319
320
321
322 /*
323 ** }=============================================================
324 */
325
326
327 Table *luaH_new (lua_State *L, int narray, int lnhash) {
328   Table *t = luaM_new(L, Table);
329   luaC_link(L, valtogco(t), LUA_TTABLE);
330   t->metatable = hvalue(defaultmeta(L));
331   t->flags = cast(lu_byte, ~0);
332   /* temporary values (kept only if some malloc fails) */
333   t->array = NULL;
334   t->sizearray = 0;
335   t->lsizenode = 0;
336   t->node = NULL;
337   setarrayvector(L, t, narray);
338   setnodevector(L, t, lnhash);
339   return t;
340 }
341
342
343 void luaH_free (lua_State *L, Table *t) {
344   if (t->lsizenode)
345     luaM_freearray(L, t->node, sizenode(t), Node);
346   luaM_freearray(L, t->array, t->sizearray, TObject);
347   luaM_freelem(L, t);
348 }
349
350
351 #if 0
352 /*
353 ** try to remove an element from a hash table; cannot move any element
354 ** (because gc can call `remove' during a table traversal)
355 */
356 void luaH_remove (Table *t, Node *e) {
357   Node *mp = luaH_mainposition(t, gkey(e));
358   if (e != mp) {  /* element not in its main position? */
359     while (mp->next != e) mp = mp->next;  /* find previous */
360     mp->next = e->next;  /* remove `e' from its list */
361   }
362   else {
363     if (e->next != NULL) ??
364   }
365   lua_assert(ttisnil(gval(node)));
366   setnilvalue(gkey(e));  /* clear node `e' */
367   e->next = NULL;
368 }
369 #endif
370
371
372 /*
373 ** inserts a new key into a hash table; first, check whether key's main 
374 ** position is free. If not, check whether colliding node is in its main 
375 ** position or not: if it is not, move colliding node to an empty place and 
376 ** put new key in its main position; otherwise (colliding node is in its main 
377 ** position), new key goes to an empty position. 
378 */
379 static TObject *newkey (lua_State *L, Table *t, const TObject *key) {
380   TObject *val;
381   Node *mp = luaH_mainposition(t, key);
382   if (!ttisnil(gval(mp))) {  /* main position is not free? */
383     Node *othern = luaH_mainposition(t, gkey(mp));  /* `mp' of colliding node */
384     Node *n = t->firstfree;  /* get a free place */
385     if (othern != mp) {  /* is colliding node out of its main position? */
386       /* yes; move colliding node into free position */
387       while (othern->next != mp) othern = othern->next;  /* find previous */
388       othern->next = n;  /* redo the chain with `n' in place of `mp' */
389       *n = *mp;  /* copy colliding node into free pos. (mp->next also goes) */
390       mp->next = NULL;  /* now `mp' is free */
391       setnilvalue(gval(mp));
392     }
393     else {  /* colliding node is in its own main position */
394       /* new node will go into free position */
395       n->next = mp->next;  /* chain new position */
396       mp->next = n;
397       mp = n;
398     }
399   }
400   setobj2t(gkey(mp), key);  /* write barrier */
401   lua_assert(ttisnil(gval(mp)));
402   for (;;) {  /* correct `firstfree' */
403     if (ttisnil(gkey(t->firstfree)))
404       return gval(mp);  /* OK; table still has a free place */
405     else if (t->firstfree == t->node) break;  /* cannot decrement from here */
406     else (t->firstfree)--;
407   }
408   /* no more free places; must create one */
409   setbvalue(gval(mp), 0);  /* avoid new key being removed */
410   rehash(L, t);  /* grow table */
411   val = cast(TObject *, luaH_get(t, key));  /* get new position */
412   lua_assert(ttisboolean(val));
413   setnilvalue(val);
414   return val;
415 }
416
417
418 /*
419 ** generic search function
420 */
421 static const TObject *luaH_getany (Table *t, const TObject *key) {
422   if (ttisnil(key)) return &luaO_nilobject;
423   else {
424     Node *n = luaH_mainposition(t, key);
425     do {  /* check whether `key' is somewhere in the chain */
426       if (luaO_rawequalObj(gkey(n), key)) return gval(n);  /* that's it */
427       else n = n->next;
428     } while (n);
429     return &luaO_nilobject;
430   }
431 }
432
433
434 /*
435 ** search function for integers
436 */
437 const TObject *luaH_getnum (Table *t, int key) {
438   if (1 <= key && key <= t->sizearray)
439     return &t->array[key-1];
440   else {
441     lua_Number nk = cast(lua_Number, key);
442     Node *n = hashnum(t, nk);
443     do {  /* check whether `key' is somewhere in the chain */
444       if (ttisnumber(gkey(n)) && nvalue(gkey(n)) == nk)
445         return gval(n);  /* that's it */
446       else n = n->next;
447     } while (n);
448     return &luaO_nilobject;
449   }
450 }
451
452
453 /*
454 ** search function for strings
455 */
456 const TObject *luaH_getstr (Table *t, TString *key) {
457   Node *n = hashstr(t, key);
458   do {  /* check whether `key' is somewhere in the chain */
459     if (ttisstring(gkey(n)) && tsvalue(gkey(n)) == key)
460       return gval(n);  /* that's it */
461     else n = n->next;
462   } while (n);
463   return &luaO_nilobject;
464 }
465
466
467 /*
468 ** main search function
469 */
470 const TObject *luaH_get (Table *t, const TObject *key) {
471   switch (ttype(key)) {
472     case LUA_TSTRING: return luaH_getstr(t, tsvalue(key));
473     case LUA_TNUMBER: {
474       int k;
475       lua_number2int(k, (nvalue(key)));
476       if (cast(lua_Number, k) == nvalue(key))  /* is an integer index? */
477         return luaH_getnum(t, k);  /* use specialized version */
478       /* else go through */
479     }
480     default: return luaH_getany(t, key);
481   }
482 }
483
484
485 TObject *luaH_set (lua_State *L, Table *t, const TObject *key) {
486   const TObject *p = luaH_get(t, key);
487   t->flags = 0;
488   if (p != &luaO_nilobject)
489     return cast(TObject *, p);
490   else {
491     if (ttisnil(key)) luaG_runerror(L, "table index is nil");
492     else if (ttisnumber(key) && nvalue(key) != nvalue(key))
493       luaG_runerror(L, "table index is NaN");
494     return newkey(L, t, key);
495   }
496 }
497
498
499 TObject *luaH_setnum (lua_State *L, Table *t, int key) {
500   const TObject *p = luaH_getnum(t, key);
501   if (p != &luaO_nilobject)
502     return cast(TObject *, p);
503   else {
504     TObject k;
505     setnvalue(&k, cast(lua_Number, key));
506     return newkey(L, t, &k);
507   }
508 }
509