lua

A copy of the Lua development repository
Log | Files | Refs | README

ltable.c (41761B)


      1 /*
      2 ** $Id: ltable.c $
      3 ** Lua tables (hash)
      4 ** See Copyright Notice in lua.h
      5 */
      6 
      7 #define ltable_c
      8 #define LUA_CORE
      9 
     10 #include "lprefix.h"
     11 
     12 
     13 /*
     14 ** Implementation of tables (aka arrays, objects, or hash tables).
     15 ** Tables keep its elements in two parts: an array part and a hash part.
     16 ** Non-negative integer keys are all candidates to be kept in the array
     17 ** part. The actual size of the array is the largest 'n' such that
     18 ** more than half the slots between 1 and n are in use.
     19 ** Hash uses a mix of chained scatter table with Brent's variation.
     20 ** A main invariant of these tables is that, if an element is not
     21 ** in its main position (i.e. the 'original' position that its hash gives
     22 ** to it), then the colliding element is in its own main position.
     23 ** Hence even when the load factor reaches 100%, performance remains good.
     24 */
     25 
     26 #include <math.h>
     27 #include <limits.h>
     28 #include <string.h>
     29 
     30 #include "lua.h"
     31 
     32 #include "ldebug.h"
     33 #include "ldo.h"
     34 #include "lgc.h"
     35 #include "lmem.h"
     36 #include "lobject.h"
     37 #include "lstate.h"
     38 #include "lstring.h"
     39 #include "ltable.h"
     40 #include "lvm.h"
     41 
     42 
     43 /*
     44 ** Only hash parts with at least 2^LIMFORLAST have a 'lastfree' field
     45 ** that optimizes finding a free slot. That field is stored just before
     46 ** the array of nodes, in the same block. Smaller tables do a complete
     47 ** search when looking for a free slot.
     48 */
     49 #define LIMFORLAST    3  /* log2 of real limit (8) */
     50 
     51 /*
     52 ** The union 'Limbox' stores 'lastfree' and ensures that what follows it
     53 ** is properly aligned to store a Node.
     54 */
     55 typedef struct { Node *dummy; Node follows_pNode; } Limbox_aux;
     56 
     57 typedef union {
     58   Node *lastfree;
     59   char padding[offsetof(Limbox_aux, follows_pNode)];
     60 } Limbox;
     61 
     62 #define haslastfree(t)     ((t)->lsizenode >= LIMFORLAST)
     63 #define getlastfree(t)     ((cast(Limbox *, (t)->node) - 1)->lastfree)
     64 
     65 
     66 /*
     67 ** MAXABITS is the largest integer such that 2^MAXABITS fits in an
     68 ** unsigned int.
     69 */
     70 #define MAXABITS	cast_int(sizeof(int) * CHAR_BIT - 1)
     71 
     72 
     73 /*
     74 ** MAXASIZEB is the maximum number of elements in the array part such
     75 ** that the size of the array fits in 'size_t'.
     76 */
     77 #define MAXASIZEB	(MAX_SIZET/(sizeof(Value) + 1))
     78 
     79 
     80 /*
     81 ** MAXASIZE is the maximum size of the array part. It is the minimum
     82 ** between 2^MAXABITS and MAXASIZEB.
     83 */
     84 #define MAXASIZE  \
     85     (((1u << MAXABITS) < MAXASIZEB) ? (1u << MAXABITS) : cast_uint(MAXASIZEB))
     86 
     87 /*
     88 ** MAXHBITS is the largest integer such that 2^MAXHBITS fits in a
     89 ** signed int.
     90 */
     91 #define MAXHBITS	(MAXABITS - 1)
     92 
     93 
     94 /*
     95 ** MAXHSIZE is the maximum size of the hash part. It is the minimum
     96 ** between 2^MAXHBITS and the maximum size such that, measured in bytes,
     97 ** it fits in a 'size_t'.
     98 */
     99 #define MAXHSIZE	luaM_limitN(1 << MAXHBITS, Node)
    100 
    101 
    102 /*
    103 ** When the original hash value is good, hashing by a power of 2
    104 ** avoids the cost of '%'.
    105 */
    106 #define hashpow2(t,n)		(gnode(t, lmod((n), sizenode(t))))
    107 
    108 /*
    109 ** for other types, it is better to avoid modulo by power of 2, as
    110 ** they can have many 2 factors.
    111 */
    112 #define hashmod(t,n)	(gnode(t, ((n) % ((sizenode(t)-1u)|1u))))
    113 
    114 
    115 #define hashstr(t,str)		hashpow2(t, (str)->hash)
    116 #define hashboolean(t,p)	hashpow2(t, p)
    117 
    118 
    119 #define hashpointer(t,p)	hashmod(t, point2uint(p))
    120 
    121 
    122 #define dummynode		(&dummynode_)
    123 
    124 /*
    125 ** Common hash part for tables with empty hash parts. That allows all
    126 ** tables to have a hash part, avoiding an extra check ("is there a hash
    127 ** part?") when indexing. Its sole node has an empty value and a key
    128 ** (DEADKEY, NULL) that is different from any valid TValue.
    129 */
    130 static const Node dummynode_ = {
    131   {{NULL}, LUA_VEMPTY,  /* value's value and type */
    132    LUA_TDEADKEY, 0, {NULL}}  /* key type, next, and key value */
    133 };
    134 
    135 
    136 static const TValue absentkey = {ABSTKEYCONSTANT};
    137 
    138 
    139 /*
    140 ** Hash for integers. To allow a good hash, use the remainder operator
    141 ** ('%'). If integer fits as a non-negative int, compute an int
    142 ** remainder, which is faster. Otherwise, use an unsigned-integer
    143 ** remainder, which uses all bits and ensures a non-negative result.
    144 */
    145 static Node *hashint (const Table *t, lua_Integer i) {
    146   lua_Unsigned ui = l_castS2U(i);
    147   if (ui <= cast_uint(INT_MAX))
    148     return gnode(t, cast_int(ui) % cast_int((sizenode(t)-1) | 1));
    149   else
    150     return hashmod(t, ui);
    151 }
    152 
    153 
    154 /*
    155 ** Hash for floating-point numbers.
    156 ** The main computation should be just
    157 **     n = frexp(n, &i); return (n * INT_MAX) + i
    158 ** but there are some numerical subtleties.
    159 ** In a two-complement representation, INT_MAX does not has an exact
    160 ** representation as a float, but INT_MIN does; because the absolute
    161 ** value of 'frexp' is smaller than 1 (unless 'n' is inf/NaN), the
    162 ** absolute value of the product 'frexp * -INT_MIN' is smaller or equal
    163 ** to INT_MAX. Next, the use of 'unsigned int' avoids overflows when
    164 ** adding 'i'; the use of '~u' (instead of '-u') avoids problems with
    165 ** INT_MIN.
    166 */
    167 #if !defined(l_hashfloat)
    168 static unsigned l_hashfloat (lua_Number n) {
    169   int i;
    170   lua_Integer ni;
    171   n = l_mathop(frexp)(n, &i) * -cast_num(INT_MIN);
    172   if (!lua_numbertointeger(n, &ni)) {  /* is 'n' inf/-inf/NaN? */
    173     lua_assert(luai_numisnan(n) || l_mathop(fabs)(n) == cast_num(HUGE_VAL));
    174     return 0;
    175   }
    176   else {  /* normal case */
    177     unsigned int u = cast_uint(i) + cast_uint(ni);
    178     return (u <= cast_uint(INT_MAX) ? u : ~u);
    179   }
    180 }
    181 #endif
    182 
    183 
    184 /*
    185 ** returns the 'main' position of an element in a table (that is,
    186 ** the index of its hash value).
    187 */
    188 static Node *mainpositionTV (const Table *t, const TValue *key) {
    189   switch (ttypetag(key)) {
    190     case LUA_VNUMINT: {
    191       lua_Integer i = ivalue(key);
    192       return hashint(t, i);
    193     }
    194     case LUA_VNUMFLT: {
    195       lua_Number n = fltvalue(key);
    196       return hashmod(t, l_hashfloat(n));
    197     }
    198     case LUA_VSHRSTR: {
    199       TString *ts = tsvalue(key);
    200       return hashstr(t, ts);
    201     }
    202     case LUA_VLNGSTR: {
    203       TString *ts = tsvalue(key);
    204       return hashpow2(t, luaS_hashlongstr(ts));
    205     }
    206     case LUA_VFALSE:
    207       return hashboolean(t, 0);
    208     case LUA_VTRUE:
    209       return hashboolean(t, 1);
    210     case LUA_VLIGHTUSERDATA: {
    211       void *p = pvalue(key);
    212       return hashpointer(t, p);
    213     }
    214     case LUA_VLCF: {
    215       lua_CFunction f = fvalue(key);
    216       return hashpointer(t, f);
    217     }
    218     default: {
    219       GCObject *o = gcvalue(key);
    220       return hashpointer(t, o);
    221     }
    222   }
    223 }
    224 
    225 
    226 l_sinline Node *mainpositionfromnode (const Table *t, Node *nd) {
    227   TValue key;
    228   getnodekey(cast(lua_State *, NULL), &key, nd);
    229   return mainpositionTV(t, &key);
    230 }
    231 
    232 
    233 /*
    234 ** Check whether key 'k1' is equal to the key in node 'n2'. This
    235 ** equality is raw, so there are no metamethods. Floats with integer
    236 ** values have been normalized, so integers cannot be equal to
    237 ** floats. It is assumed that 'eqshrstr' is simply pointer equality, so
    238 ** that short strings are handled in the default case.
    239 ** A true 'deadok' means to accept dead keys as equal to their original
    240 ** values. All dead keys are compared in the default case, by pointer
    241 ** identity. (Only collectable objects can produce dead keys.) Note that
    242 ** dead long strings are also compared by identity.
    243 ** Once a key is dead, its corresponding value may be collected, and
    244 ** then another value can be created with the same address. If this
    245 ** other value is given to 'next', 'equalkey' will signal a false
    246 ** positive. In a regular traversal, this situation should never happen,
    247 ** as all keys given to 'next' came from the table itself, and therefore
    248 ** could not have been collected. Outside a regular traversal, we
    249 ** have garbage in, garbage out. What is relevant is that this false
    250 ** positive does not break anything.  (In particular, 'next' will return
    251 ** some other valid item on the table or nil.)
    252 */
    253 static int equalkey (const TValue *k1, const Node *n2, int deadok) {
    254   if ((rawtt(k1) != keytt(n2)) &&  /* not the same variants? */
    255        !(deadok && keyisdead(n2) && iscollectable(k1)))
    256    return 0;  /* cannot be same key */
    257   switch (keytt(n2)) {
    258     case LUA_VNIL: case LUA_VFALSE: case LUA_VTRUE:
    259       return 1;
    260     case LUA_VNUMINT:
    261       return (ivalue(k1) == keyival(n2));
    262     case LUA_VNUMFLT:
    263       return luai_numeq(fltvalue(k1), fltvalueraw(keyval(n2)));
    264     case LUA_VLIGHTUSERDATA:
    265       return pvalue(k1) == pvalueraw(keyval(n2));
    266     case LUA_VLCF:
    267       return fvalue(k1) == fvalueraw(keyval(n2));
    268     case ctb(LUA_VLNGSTR):
    269       return luaS_eqlngstr(tsvalue(k1), keystrval(n2));
    270     default:
    271       return gcvalue(k1) == gcvalueraw(keyval(n2));
    272   }
    273 }
    274 
    275 
    276 /*
    277 ** "Generic" get version. (Not that generic: not valid for integers,
    278 ** which may be in array part, nor for floats with integral values.)
    279 ** See explanation about 'deadok' in function 'equalkey'.
    280 */
    281 static const TValue *getgeneric (Table *t, const TValue *key, int deadok) {
    282   Node *n = mainpositionTV(t, key);
    283   for (;;) {  /* check whether 'key' is somewhere in the chain */
    284     if (equalkey(key, n, deadok))
    285       return gval(n);  /* that's it */
    286     else {
    287       int nx = gnext(n);
    288       if (nx == 0)
    289         return &absentkey;  /* not found */
    290       n += nx;
    291     }
    292   }
    293 }
    294 
    295 
    296 /*
    297 ** Return the index 'k' (converted to an unsigned) if it is inside
    298 ** the range [1, limit].
    299 */
    300 static unsigned checkrange (lua_Integer k, unsigned limit) {
    301   return (l_castS2U(k) - 1u < limit) ? cast_uint(k) : 0;
    302 }
    303 
    304 
    305 /*
    306 ** Return the index 'k' if 'k' is an appropriate key to live in the
    307 ** array part of a table, 0 otherwise.
    308 */
    309 #define arrayindex(k)	checkrange(k, MAXASIZE)
    310 
    311 
    312 /*
    313 ** Check whether an integer key is in the array part of a table and
    314 ** return its index there, or zero.
    315 */
    316 #define ikeyinarray(t,k)	checkrange(k, t->asize)
    317 
    318 
    319 /*
    320 ** Check whether a key is in the array part of a table and return its
    321 ** index there, or zero.
    322 */
    323 static unsigned keyinarray (Table *t, const TValue *key) {
    324   return (ttisinteger(key)) ? ikeyinarray(t, ivalue(key)) : 0;
    325 }
    326 
    327 
    328 /*
    329 ** returns the index of a 'key' for table traversals. First goes all
    330 ** elements in the array part, then elements in the hash part. The
    331 ** beginning of a traversal is signaled by 0.
    332 */
    333 static unsigned findindex (lua_State *L, Table *t, TValue *key,
    334                                unsigned asize) {
    335   unsigned int i;
    336   if (ttisnil(key)) return 0;  /* first iteration */
    337   i = keyinarray(t, key);
    338   if (i != 0)  /* is 'key' inside array part? */
    339     return i;  /* yes; that's the index */
    340   else {
    341     const TValue *n = getgeneric(t, key, 1);
    342     if (l_unlikely(isabstkey(n)))
    343       luaG_runerror(L, "invalid key to 'next'");  /* key not found */
    344     i = cast_uint(nodefromval(n) - gnode(t, 0));  /* key index in hash table */
    345     /* hash elements are numbered after array ones */
    346     return (i + 1) + asize;
    347   }
    348 }
    349 
    350 
    351 int luaH_next (lua_State *L, Table *t, StkId key) {
    352   unsigned int asize = t->asize;
    353   unsigned int i = findindex(L, t, s2v(key), asize);  /* find original key */
    354   for (; i < asize; i++) {  /* try first array part */
    355     lu_byte tag = *getArrTag(t, i);
    356     if (!tagisempty(tag)) {  /* a non-empty entry? */
    357       setivalue(s2v(key), cast_int(i) + 1);
    358       farr2val(t, i, tag, s2v(key + 1));
    359       return 1;
    360     }
    361   }
    362   for (i -= asize; i < sizenode(t); i++) {  /* hash part */
    363     if (!isempty(gval(gnode(t, i)))) {  /* a non-empty entry? */
    364       Node *n = gnode(t, i);
    365       getnodekey(L, s2v(key), n);
    366       setobj2s(L, key + 1, gval(n));
    367       return 1;
    368     }
    369   }
    370   return 0;  /* no more elements */
    371 }
    372 
    373 
    374 /* Extra space in Node array if it has a lastfree entry */
    375 #define extraLastfree(t)	(haslastfree(t) ? sizeof(Limbox) : 0)
    376 
    377 /* 'node' size in bytes */
    378 static size_t sizehash (Table *t) {
    379   return cast_sizet(sizenode(t)) * sizeof(Node) + extraLastfree(t);
    380 }
    381 
    382 
    383 static void freehash (lua_State *L, Table *t) {
    384   if (!isdummy(t)) {
    385     /* get pointer to the beginning of Node array */
    386     char *arr = cast_charp(t->node) - extraLastfree(t);
    387     luaM_freearray(L, arr, sizehash(t));
    388   }
    389 }
    390 
    391 
    392 /*
    393 ** {=============================================================
    394 ** Rehash
    395 ** ==============================================================
    396 */
    397 
    398 static int insertkey (Table *t, const TValue *key, TValue *value);
    399 static void newcheckedkey (Table *t, const TValue *key, TValue *value);
    400 
    401 
    402 /*
    403 ** Structure to count the keys in a table.
    404 ** 'total' is the total number of keys in the table.
    405 ** 'na' is the number of *array indices* in the table (see 'arrayindex').
    406 ** 'deleted' is true if there are deleted nodes in the hash part.
    407 ** 'nums' is a "count array" where 'nums[i]' is the number of integer
    408 ** keys between 2^(i - 1) + 1 and 2^i. Note that 'na' is the summation
    409 ** of 'nums'.
    410 */
    411 typedef struct {
    412   unsigned total;
    413   unsigned na;
    414   int deleted;
    415   unsigned nums[MAXABITS + 1];
    416 } Counters;
    417 
    418 
    419 /*
    420 ** Check whether it is worth to use 'na' array entries instead of 'nh'
    421 ** hash nodes. (A hash node uses ~3 times more memory than an array
    422 ** entry: Two values plus 'next' versus one value.) Evaluate with size_t
    423 ** to avoid overflows.
    424 */
    425 #define arrayXhash(na,nh)	(cast_sizet(na) <= cast_sizet(nh) * 3)
    426 
    427 /*
    428 ** Compute the optimal size for the array part of table 't'.
    429 ** This size maximizes the number of elements going to the array part
    430 ** while satisfying the condition 'arrayXhash' with the use of memory if
    431 ** all those elements went to the hash part.
    432 ** 'ct->na' enters with the total number of array indices in the table
    433 ** and leaves with the number of keys that will go to the array part;
    434 ** return the optimal size for the array part.
    435 */
    436 static unsigned computesizes (Counters *ct) {
    437   int i;
    438   unsigned int twotoi;  /* 2^i (candidate for optimal size) */
    439   unsigned int a = 0;  /* number of elements smaller than 2^i */
    440   unsigned int na = 0;  /* number of elements to go to array part */
    441   unsigned int optimal = 0;  /* optimal size for array part */
    442   /* traverse slices while 'twotoi' does not overflow and total of array
    443      indices still can satisfy 'arrayXhash' against the array size */
    444   for (i = 0, twotoi = 1;
    445        twotoi > 0 && arrayXhash(twotoi, ct->na);
    446        i++, twotoi *= 2) {
    447     unsigned nums = ct->nums[i];
    448     a += nums;
    449     if (nums > 0 &&  /* grows array only if it gets more elements... */
    450         arrayXhash(twotoi, a)) {  /* ...while using "less memory" */
    451       optimal = twotoi;  /* optimal size (till now) */
    452       na = a;  /* all elements up to 'optimal' will go to array part */
    453     }
    454   }
    455   ct->na = na;
    456   return optimal;
    457 }
    458 
    459 
    460 static void countint (lua_Integer key, Counters *ct) {
    461   unsigned int k = arrayindex(key);
    462   if (k != 0) {  /* is 'key' an array index? */
    463     ct->nums[luaO_ceillog2(k)]++;  /* count as such */
    464     ct->na++;
    465   }
    466 }
    467 
    468 
    469 l_sinline int arraykeyisempty (const Table *t, unsigned key) {
    470   int tag = *getArrTag(t, key - 1);
    471   return tagisempty(tag);
    472 }
    473 
    474 
    475 /*
    476 ** Count keys in array part of table 't'.
    477 */
    478 static void numusearray (const Table *t, Counters *ct) {
    479   int lg;
    480   unsigned int ttlg;  /* 2^lg */
    481   unsigned int ause = 0;  /* summation of 'nums' */
    482   unsigned int i = 1;  /* index to traverse all array keys */
    483   unsigned int asize = t->asize;
    484   /* traverse each slice */
    485   for (lg = 0, ttlg = 1; lg <= MAXABITS; lg++, ttlg *= 2) {
    486     unsigned int lc = 0;  /* counter */
    487     unsigned int lim = ttlg;
    488     if (lim > asize) {
    489       lim = asize;  /* adjust upper limit */
    490       if (i > lim)
    491         break;  /* no more elements to count */
    492     }
    493     /* count elements in range (2^(lg - 1), 2^lg] */
    494     for (; i <= lim; i++) {
    495       if (!arraykeyisempty(t, i))
    496         lc++;
    497     }
    498     ct->nums[lg] += lc;
    499     ause += lc;
    500   }
    501   ct->total += ause;
    502   ct->na += ause;
    503 }
    504 
    505 
    506 /*
    507 ** Count keys in hash part of table 't'. As this only happens during
    508 ** a rehash, all nodes have been used. A node can have a nil value only
    509 ** if it was deleted after being created.
    510 */
    511 static void numusehash (const Table *t, Counters *ct) {
    512   unsigned i = sizenode(t);
    513   unsigned total = 0;
    514   while (i--) {
    515     Node *n = &t->node[i];
    516     if (isempty(gval(n))) {
    517       lua_assert(!keyisnil(n));  /* entry was deleted; key cannot be nil */
    518       ct->deleted = 1;
    519     }
    520     else {
    521       total++;
    522       if (keyisinteger(n))
    523         countint(keyival(n), ct);
    524     }
    525   }
    526   ct->total += total;
    527 }
    528 
    529 
    530 /*
    531 ** Convert an "abstract size" (number of slots in an array) to
    532 ** "concrete size" (number of bytes in the array).
    533 */
    534 static size_t concretesize (unsigned int size) {
    535   if (size == 0)
    536     return 0;
    537   else  /* space for the two arrays plus an unsigned in between */
    538     return size * (sizeof(Value) + 1) + sizeof(unsigned);
    539 }
    540 
    541 
    542 /*
    543 ** Resize the array part of a table. If new size is equal to the old,
    544 ** do nothing. Else, if new size is zero, free the old array. (It must
    545 ** be present, as the sizes are different.) Otherwise, allocate a new
    546 ** array, move the common elements to new proper position, and then
    547 ** frees the old array.
    548 ** We could reallocate the array, but we still would need to move the
    549 ** elements to their new position, so the copy implicit in realloc is a
    550 ** waste. Moreover, most allocators will move the array anyway when the
    551 ** new size is double the old one (the most common case).
    552 */
    553 static Value *resizearray (lua_State *L , Table *t,
    554                                unsigned oldasize,
    555                                unsigned newasize) {
    556   if (oldasize == newasize)
    557     return t->array;  /* nothing to be done */
    558   else if (newasize == 0) {  /* erasing array? */
    559     Value *op = t->array - oldasize;  /* original array's real address */
    560     luaM_freemem(L, op, concretesize(oldasize));  /* free it */
    561     return NULL;
    562   }
    563   else {
    564     size_t newasizeb = concretesize(newasize);
    565     Value *np = cast(Value *,
    566                   luaM_reallocvector(L, NULL, 0, newasizeb, lu_byte));
    567     if (np == NULL)  /* allocation error? */
    568       return NULL;
    569     np += newasize;  /* shift pointer to the end of value segment */
    570     if (oldasize > 0) {
    571       /* move common elements to new position */
    572       size_t oldasizeb = concretesize(oldasize);
    573       Value *op = t->array;  /* original array */
    574       unsigned tomove = (oldasize < newasize) ? oldasize : newasize;
    575       size_t tomoveb = (oldasize < newasize) ? oldasizeb : newasizeb;
    576       lua_assert(tomoveb > 0);
    577       memcpy(np - tomove, op - tomove, tomoveb);
    578       luaM_freemem(L, op - oldasize, oldasizeb);  /* free old block */
    579     }
    580     return np;
    581   }
    582 }
    583 
    584 
    585 /*
    586 ** Creates an array for the hash part of a table with the given
    587 ** size, or reuses the dummy node if size is zero.
    588 ** The computation for size overflow is in two steps: the first
    589 ** comparison ensures that the shift in the second one does not
    590 ** overflow.
    591 */
    592 static void setnodevector (lua_State *L, Table *t, unsigned size) {
    593   if (size == 0) {  /* no elements to hash part? */
    594     t->node = cast(Node *, dummynode);  /* use common 'dummynode' */
    595     t->lsizenode = 0;
    596     setdummy(t);  /* signal that it is using dummy node */
    597   }
    598   else {
    599     int i;
    600     int lsize = luaO_ceillog2(size);
    601     if (lsize > MAXHBITS || (1 << lsize) > MAXHSIZE)
    602       luaG_runerror(L, "table overflow");
    603     size = twoto(lsize);
    604     if (lsize < LIMFORLAST)  /* no 'lastfree' field? */
    605       t->node = luaM_newvector(L, size, Node);
    606     else {
    607       size_t bsize = size * sizeof(Node) + sizeof(Limbox);
    608       char *node = luaM_newblock(L, bsize);
    609       t->node = cast(Node *, node + sizeof(Limbox));
    610       getlastfree(t) = gnode(t, size);  /* all positions are free */
    611     }
    612     t->lsizenode = cast_byte(lsize);
    613     setnodummy(t);
    614     for (i = 0; i < cast_int(size); i++) {
    615       Node *n = gnode(t, i);
    616       gnext(n) = 0;
    617       setnilkey(n);
    618       setempty(gval(n));
    619     }
    620   }
    621 }
    622 
    623 
    624 /*
    625 ** (Re)insert all elements from the hash part of 'ot' into table 't'.
    626 */
    627 static void reinserthash (lua_State *L, Table *ot, Table *t) {
    628   unsigned j;
    629   unsigned size = sizenode(ot);
    630   for (j = 0; j < size; j++) {
    631     Node *old = gnode(ot, j);
    632     if (!isempty(gval(old))) {
    633       /* doesn't need barrier/invalidate cache, as entry was
    634          already present in the table */
    635       TValue k;
    636       getnodekey(L, &k, old);
    637       newcheckedkey(t, &k, gval(old));
    638     }
    639   }
    640 }
    641 
    642 
    643 /*
    644 ** Exchange the hash part of 't1' and 't2'. (In 'flags', only the
    645 ** dummy bit must be exchanged: The 'isrealasize' is not related
    646 ** to the hash part, and the metamethod bits do not change during
    647 ** a resize, so the "real" table can keep their values.)
    648 */
    649 static void exchangehashpart (Table *t1, Table *t2) {
    650   lu_byte lsizenode = t1->lsizenode;
    651   Node *node = t1->node;
    652   int bitdummy1 = t1->flags & BITDUMMY;
    653   t1->lsizenode = t2->lsizenode;
    654   t1->node = t2->node;
    655   t1->flags = cast_byte((t1->flags & NOTBITDUMMY) | (t2->flags & BITDUMMY));
    656   t2->lsizenode = lsizenode;
    657   t2->node = node;
    658   t2->flags = cast_byte((t2->flags & NOTBITDUMMY) | bitdummy1);
    659 }
    660 
    661 
    662 /*
    663 ** Re-insert into the new hash part of a table the elements from the
    664 ** vanishing slice of the array part.
    665 */
    666 static void reinsertOldSlice (Table *t, unsigned oldasize,
    667                                         unsigned newasize) {
    668   unsigned i;
    669   for (i = newasize; i < oldasize; i++) {  /* traverse vanishing slice */
    670     lu_byte tag = *getArrTag(t, i);
    671     if (!tagisempty(tag)) {  /* a non-empty entry? */
    672       TValue key, aux;
    673       setivalue(&key, l_castU2S(i) + 1);  /* make the key */
    674       farr2val(t, i, tag, &aux);  /* copy value into 'aux' */
    675       insertkey(t, &key, &aux);  /* insert entry into the hash part */
    676     }
    677   }
    678 }
    679 
    680 
    681 /*
    682 ** Clear new slice of the array.
    683 */
    684 static void clearNewSlice (Table *t, unsigned oldasize, unsigned newasize) {
    685   for (; oldasize < newasize; oldasize++)
    686     *getArrTag(t, oldasize) = LUA_VEMPTY;
    687 }
    688 
    689 
    690 /*
    691 ** Resize table 't' for the new given sizes. Both allocations (for
    692 ** the hash part and for the array part) can fail, which creates some
    693 ** subtleties. If the first allocation, for the hash part, fails, an
    694 ** error is raised and that is it. Otherwise, it copies the elements from
    695 ** the shrinking part of the array (if it is shrinking) into the new
    696 ** hash. Then it reallocates the array part.  If that fails, the table
    697 ** is in its original state; the function frees the new hash part and then
    698 ** raises the allocation error. Otherwise, it sets the new hash part
    699 ** into the table, initializes the new part of the array (if any) with
    700 ** nils and reinserts the elements of the old hash back into the new
    701 ** parts of the table.
    702 ** Note that if the new size for the array part ('newasize') is equal to
    703 ** the old one ('oldasize'), this function will do nothing with that
    704 ** part.
    705 */
    706 void luaH_resize (lua_State *L, Table *t, unsigned newasize,
    707                                           unsigned nhsize) {
    708   Table newt;  /* to keep the new hash part */
    709   unsigned oldasize = t->asize;
    710   Value *newarray;
    711   if (newasize > MAXASIZE)
    712     luaG_runerror(L, "table overflow");
    713   /* create new hash part with appropriate size into 'newt' */
    714   newt.flags = 0;
    715   setnodevector(L, &newt, nhsize);
    716   if (newasize < oldasize) {  /* will array shrink? */
    717     /* re-insert into the new hash the elements from vanishing slice */
    718     exchangehashpart(t, &newt);  /* pretend table has new hash */
    719     reinsertOldSlice(t, oldasize, newasize);
    720     exchangehashpart(t, &newt);  /* restore old hash (in case of errors) */
    721   }
    722   /* allocate new array */
    723   newarray = resizearray(L, t, oldasize, newasize);
    724   if (l_unlikely(newarray == NULL && newasize > 0)) {  /* allocation failed? */
    725     freehash(L, &newt);  /* release new hash part */
    726     luaM_error(L);  /* raise error (with array unchanged) */
    727   }
    728   /* allocation ok; initialize new part of the array */
    729   exchangehashpart(t, &newt);  /* 't' has the new hash ('newt' has the old) */
    730   t->array = newarray;  /* set new array part */
    731   t->asize = newasize;
    732   if (newarray != NULL)
    733     *lenhint(t) = newasize / 2u;  /* set an initial hint */
    734   clearNewSlice(t, oldasize, newasize);
    735   /* re-insert elements from old hash part into new parts */
    736   reinserthash(L, &newt, t);  /* 'newt' now has the old hash */
    737   freehash(L, &newt);  /* free old hash part */
    738 }
    739 
    740 
    741 void luaH_resizearray (lua_State *L, Table *t, unsigned int nasize) {
    742   unsigned nsize = allocsizenode(t);
    743   luaH_resize(L, t, nasize, nsize);
    744 }
    745 
    746 
    747 /*
    748 ** Rehash a table. First, count its keys. If there are array indices
    749 ** outside the array part, compute the new best size for that part.
    750 ** Then, resize the table.
    751 */
    752 static void rehash (lua_State *L, Table *t, const TValue *ek) {
    753   unsigned asize;  /* optimal size for array part */
    754   Counters ct;
    755   unsigned i;
    756   unsigned nsize;  /* size for the hash part */
    757   /* reset counts */
    758   for (i = 0; i <= MAXABITS; i++) ct.nums[i] = 0;
    759   ct.na = 0;
    760   ct.deleted = 0;
    761   ct.total = 1;  /* count extra key */
    762   if (ttisinteger(ek))
    763     countint(ivalue(ek), &ct);  /* extra key may go to array */
    764   numusehash(t, &ct);  /* count keys in hash part */
    765   if (ct.na == 0) {
    766     /* no new keys to enter array part; keep it with the same size */
    767     asize = t->asize;
    768   }
    769   else {  /* compute best size for array part */
    770     numusearray(t, &ct);  /* count keys in array part */
    771     asize = computesizes(&ct);  /* compute new size for array part */
    772   }
    773   /* all keys not in the array part go to the hash part */
    774   nsize = ct.total - ct.na;
    775   if (ct.deleted) {  /* table has deleted entries? */
    776     /* insertion-deletion-insertion: give hash some extra size to
    777        avoid repeated resizings */
    778     nsize += nsize >> 2;
    779   }
    780   /* resize the table to new computed sizes */
    781   luaH_resize(L, t, asize, nsize);
    782 }
    783 
    784 /*
    785 ** }=============================================================
    786 */
    787 
    788 
    789 Table *luaH_new (lua_State *L) {
    790   GCObject *o = luaC_newobj(L, LUA_VTABLE, sizeof(Table));
    791   Table *t = gco2t(o);
    792   t->metatable = NULL;
    793   t->flags = maskflags;  /* table has no metamethod fields */
    794   t->array = NULL;
    795   t->asize = 0;
    796   setnodevector(L, t, 0);
    797   return t;
    798 }
    799 
    800 
    801 lu_mem luaH_size (Table *t) {
    802   lu_mem sz = cast(lu_mem, sizeof(Table)) + concretesize(t->asize);
    803   if (!isdummy(t))
    804     sz += sizehash(t);
    805   return sz;
    806 }
    807 
    808 
    809 /*
    810 ** Frees a table.
    811 */
    812 void luaH_free (lua_State *L, Table *t) {
    813   freehash(L, t);
    814   resizearray(L, t, t->asize, 0);
    815   luaM_free(L, t);
    816 }
    817 
    818 
    819 static Node *getfreepos (Table *t) {
    820   if (haslastfree(t)) {  /* does it have 'lastfree' information? */
    821     /* look for a spot before 'lastfree', updating 'lastfree' */
    822     while (getlastfree(t) > t->node) {
    823       Node *free = --getlastfree(t);
    824       if (keyisnil(free))
    825         return free;
    826     }
    827   }
    828   else {  /* no 'lastfree' information */
    829     unsigned i = sizenode(t);
    830     while (i--) {  /* do a linear search */
    831       Node *free = gnode(t, i);
    832       if (keyisnil(free))
    833         return free;
    834     }
    835   }
    836   return NULL;  /* could not find a free place */
    837 }
    838 
    839 
    840 
    841 /*
    842 ** Inserts a new key into a hash table; first, check whether key's main
    843 ** position is free. If not, check whether colliding node is in its main
    844 ** position or not: if it is not, move colliding node to an empty place
    845 ** and put new key in its main position; otherwise (colliding node is in
    846 ** its main position), new key goes to an empty position. Return 0 if
    847 ** could not insert key (could not find a free space).
    848 */
    849 static int insertkey (Table *t, const TValue *key, TValue *value) {
    850   Node *mp = mainpositionTV(t, key);
    851   /* table cannot already contain the key */
    852   lua_assert(isabstkey(getgeneric(t, key, 0)));
    853   if (!isempty(gval(mp)) || isdummy(t)) {  /* main position is taken? */
    854     Node *othern;
    855     Node *f = getfreepos(t);  /* get a free place */
    856     if (f == NULL)  /* cannot find a free place? */
    857       return 0;
    858     lua_assert(!isdummy(t));
    859     othern = mainpositionfromnode(t, mp);
    860     if (othern != mp) {  /* is colliding node out of its main position? */
    861       /* yes; move colliding node into free position */
    862       while (othern + gnext(othern) != mp)  /* find previous */
    863         othern += gnext(othern);
    864       gnext(othern) = cast_int(f - othern);  /* rechain to point to 'f' */
    865       *f = *mp;  /* copy colliding node into free pos. (mp->next also goes) */
    866       if (gnext(mp) != 0) {
    867         gnext(f) += cast_int(mp - f);  /* correct 'next' */
    868         gnext(mp) = 0;  /* now 'mp' is free */
    869       }
    870       setempty(gval(mp));
    871     }
    872     else {  /* colliding node is in its own main position */
    873       /* new node will go into free position */
    874       if (gnext(mp) != 0)
    875         gnext(f) = cast_int((mp + gnext(mp)) - f);  /* chain new position */
    876       else lua_assert(gnext(f) == 0);
    877       gnext(mp) = cast_int(f - mp);
    878       mp = f;
    879     }
    880   }
    881   setnodekey(mp, key);
    882   lua_assert(isempty(gval(mp)));
    883   setobj2t(cast(lua_State *, 0), gval(mp), value);
    884   return 1;
    885 }
    886 
    887 
    888 /*
    889 ** Insert a key in a table where there is space for that key, the
    890 ** key is valid, and the value is not nil.
    891 */
    892 static void newcheckedkey (Table *t, const TValue *key, TValue *value) {
    893   unsigned i = keyinarray(t, key);
    894   if (i > 0)  /* is key in the array part? */
    895     obj2arr(t, i - 1, value);  /* set value in the array */
    896   else {
    897     int done = insertkey(t, key, value);  /* insert key in the hash part */
    898     lua_assert(done);  /* it cannot fail */
    899     cast(void, done);  /* to avoid warnings */
    900   }
    901 }
    902 
    903 
    904 static void luaH_newkey (lua_State *L, Table *t, const TValue *key,
    905                                                  TValue *value) {
    906   if (!ttisnil(value)) {  /* do not insert nil values */
    907     int done = insertkey(t, key, value);
    908     if (!done) {  /* could not find a free place? */
    909       rehash(L, t, key);  /* grow table */
    910       newcheckedkey(t, key, value);  /* insert key in grown table */
    911     }
    912     luaC_barrierback(L, obj2gco(t), key);
    913     /* for debugging only: any new key may force an emergency collection */
    914     condchangemem(L, (void)0, (void)0, 1);
    915   }
    916 }
    917 
    918 
    919 static const TValue *getintfromhash (Table *t, lua_Integer key) {
    920   Node *n = hashint(t, key);
    921   lua_assert(!ikeyinarray(t, key));
    922   for (;;) {  /* check whether 'key' is somewhere in the chain */
    923     if (keyisinteger(n) && keyival(n) == key)
    924       return gval(n);  /* that's it */
    925     else {
    926       int nx = gnext(n);
    927       if (nx == 0) break;
    928       n += nx;
    929     }
    930   }
    931   return &absentkey;
    932 }
    933 
    934 
    935 static int hashkeyisempty (Table *t, lua_Unsigned key) {
    936   const TValue *val = getintfromhash(t, l_castU2S(key));
    937   return isempty(val);
    938 }
    939 
    940 
    941 static lu_byte finishnodeget (const TValue *val, TValue *res) {
    942   if (!ttisnil(val)) {
    943     setobj(((lua_State*)NULL), res, val);
    944   }
    945   return ttypetag(val);
    946 }
    947 
    948 
    949 lu_byte luaH_getint (Table *t, lua_Integer key, TValue *res) {
    950   unsigned k = ikeyinarray(t, key);
    951   if (k > 0) {
    952     lu_byte tag = *getArrTag(t, k - 1);
    953     if (!tagisempty(tag))
    954       farr2val(t, k - 1, tag, res);
    955     return tag;
    956   }
    957   else
    958     return finishnodeget(getintfromhash(t, key), res);
    959 }
    960 
    961 
    962 /*
    963 ** search function for short strings
    964 */
    965 const TValue *luaH_Hgetshortstr (Table *t, TString *key) {
    966   Node *n = hashstr(t, key);
    967   lua_assert(strisshr(key));
    968   for (;;) {  /* check whether 'key' is somewhere in the chain */
    969     if (keyisshrstr(n) && eqshrstr(keystrval(n), key))
    970       return gval(n);  /* that's it */
    971     else {
    972       int nx = gnext(n);
    973       if (nx == 0)
    974         return &absentkey;  /* not found */
    975       n += nx;
    976     }
    977   }
    978 }
    979 
    980 
    981 lu_byte luaH_getshortstr (Table *t, TString *key, TValue *res) {
    982   return finishnodeget(luaH_Hgetshortstr(t, key), res);
    983 }
    984 
    985 
    986 static const TValue *Hgetlongstr (Table *t, TString *key) {
    987   TValue ko;
    988   lua_assert(!strisshr(key));
    989   setsvalue(cast(lua_State *, NULL), &ko, key);
    990   return getgeneric(t, &ko, 0);  /* for long strings, use generic case */
    991 }
    992 
    993 
    994 static const TValue *Hgetstr (Table *t, TString *key) {
    995   if (strisshr(key))
    996     return luaH_Hgetshortstr(t, key);
    997   else
    998     return Hgetlongstr(t, key);
    999 }
   1000 
   1001 
   1002 lu_byte luaH_getstr (Table *t, TString *key, TValue *res) {
   1003   return finishnodeget(Hgetstr(t, key), res);
   1004 }
   1005 
   1006 
   1007 /*
   1008 ** main search function
   1009 */
   1010 lu_byte luaH_get (Table *t, const TValue *key, TValue *res) {
   1011   const TValue *slot;
   1012   switch (ttypetag(key)) {
   1013     case LUA_VSHRSTR:
   1014       slot = luaH_Hgetshortstr(t, tsvalue(key));
   1015       break;
   1016     case LUA_VNUMINT:
   1017       return luaH_getint(t, ivalue(key), res);
   1018     case LUA_VNIL:
   1019       slot = &absentkey;
   1020       break;
   1021     case LUA_VNUMFLT: {
   1022       lua_Integer k;
   1023       if (luaV_flttointeger(fltvalue(key), &k, F2Ieq)) /* integral index? */
   1024         return luaH_getint(t, k, res);  /* use specialized version */
   1025       /* else... */
   1026     }  /* FALLTHROUGH */
   1027     default:
   1028       slot = getgeneric(t, key, 0);
   1029       break;
   1030   }
   1031   return finishnodeget(slot, res);
   1032 }
   1033 
   1034 
   1035 /*
   1036 ** When a 'pset' cannot be completed, this function returns an encoding
   1037 ** of its result, to be used by 'luaH_finishset'.
   1038 */
   1039 static int retpsetcode (Table *t, const TValue *slot) {
   1040   if (isabstkey(slot))
   1041     return HNOTFOUND;  /* no slot with that key */
   1042   else  /* return node encoded */
   1043     return cast_int((cast(Node*, slot) - t->node)) + HFIRSTNODE;
   1044 }
   1045 
   1046 
   1047 static int finishnodeset (Table *t, const TValue *slot, TValue *val) {
   1048   if (!ttisnil(slot)) {
   1049     setobj(((lua_State*)NULL), cast(TValue*, slot), val);
   1050     return HOK;  /* success */
   1051   }
   1052   else
   1053     return retpsetcode(t, slot);
   1054 }
   1055 
   1056 
   1057 static int rawfinishnodeset (const TValue *slot, TValue *val) {
   1058   if (isabstkey(slot))
   1059     return 0;  /* no slot with that key */
   1060   else {
   1061     setobj(((lua_State*)NULL), cast(TValue*, slot), val);
   1062     return 1;  /* success */
   1063   }
   1064 }
   1065 
   1066 
   1067 int luaH_psetint (Table *t, lua_Integer key, TValue *val) {
   1068   lua_assert(!ikeyinarray(t, key));
   1069   return finishnodeset(t, getintfromhash(t, key), val);
   1070 }
   1071 
   1072 
   1073 static int psetint (Table *t, lua_Integer key, TValue *val) {
   1074   int hres;
   1075   luaH_fastseti(t, key, val, hres);
   1076   return hres;
   1077 }
   1078 
   1079 
   1080 /*
   1081 ** This function could be just this:
   1082 **    return finishnodeset(t, luaH_Hgetshortstr(t, key), val);
   1083 ** However, it optimizes the common case created by constructors (e.g.,
   1084 ** {x=1, y=2}), which creates a key in a table that has no metatable,
   1085 ** it is not old/black, and it already has space for the key.
   1086 */
   1087 
   1088 int luaH_psetshortstr (Table *t, TString *key, TValue *val) {
   1089   const TValue *slot = luaH_Hgetshortstr(t, key);
   1090   if (!ttisnil(slot)) {  /* key already has a value? (all too common) */
   1091     setobj(((lua_State*)NULL), cast(TValue*, slot), val);  /* update it */
   1092     return HOK;  /* done */
   1093   }
   1094   else if (checknoTM(t->metatable, TM_NEWINDEX)) {  /* no metamethod? */
   1095     if (ttisnil(val))  /* new value is nil? */
   1096       return HOK;  /* done (value is already nil/absent) */
   1097     if (isabstkey(slot) &&  /* key is absent? */
   1098        !(isblack(t) && iswhite(key))) {  /* and don't need barrier? */
   1099       TValue tk;  /* key as a TValue */
   1100       setsvalue(cast(lua_State *, NULL), &tk, key);
   1101       if (insertkey(t, &tk, val)) {  /* insert key, if there is space */
   1102         invalidateTMcache(t);
   1103         return HOK;
   1104       }
   1105     }
   1106   }
   1107   /* Else, either table has new-index metamethod, or it needs barrier,
   1108      or it needs to rehash for the new key. In any of these cases, the
   1109      operation cannot be completed here. Return a code for the caller. */
   1110   return retpsetcode(t, slot);
   1111 }
   1112 
   1113 
   1114 int luaH_psetstr (Table *t, TString *key, TValue *val) {
   1115   if (strisshr(key))
   1116     return luaH_psetshortstr(t, key, val);
   1117   else
   1118     return finishnodeset(t, Hgetlongstr(t, key), val);
   1119 }
   1120 
   1121 
   1122 int luaH_pset (Table *t, const TValue *key, TValue *val) {
   1123   switch (ttypetag(key)) {
   1124     case LUA_VSHRSTR: return luaH_psetshortstr(t, tsvalue(key), val);
   1125     case LUA_VNUMINT: return psetint(t, ivalue(key), val);
   1126     case LUA_VNIL: return HNOTFOUND;
   1127     case LUA_VNUMFLT: {
   1128       lua_Integer k;
   1129       if (luaV_flttointeger(fltvalue(key), &k, F2Ieq)) /* integral index? */
   1130         return psetint(t, k, val);  /* use specialized version */
   1131       /* else... */
   1132     }  /* FALLTHROUGH */
   1133     default:
   1134       return finishnodeset(t, getgeneric(t, key, 0), val);
   1135   }
   1136 }
   1137 
   1138 /*
   1139 ** Finish a raw "set table" operation, where 'hres' encodes where the
   1140 ** value should have been (the result of a previous 'pset' operation).
   1141 ** Beware: when using this function the caller probably need to check a
   1142 ** GC barrier and invalidate the TM cache.
   1143 */
   1144 void luaH_finishset (lua_State *L, Table *t, const TValue *key,
   1145                                     TValue *value, int hres) {
   1146   lua_assert(hres != HOK);
   1147   if (hres == HNOTFOUND) {
   1148     TValue aux;
   1149     if (l_unlikely(ttisnil(key)))
   1150       luaG_runerror(L, "table index is nil");
   1151     else if (ttisfloat(key)) {
   1152       lua_Number f = fltvalue(key);
   1153       lua_Integer k;
   1154       if (luaV_flttointeger(f, &k, F2Ieq)) {
   1155         setivalue(&aux, k);  /* key is equal to an integer */
   1156         key = &aux;  /* insert it as an integer */
   1157       }
   1158       else if (l_unlikely(luai_numisnan(f)))
   1159         luaG_runerror(L, "table index is NaN");
   1160     }
   1161     luaH_newkey(L, t, key, value);
   1162   }
   1163   else if (hres > 0) {  /* regular Node? */
   1164     setobj2t(L, gval(gnode(t, hres - HFIRSTNODE)), value);
   1165   }
   1166   else {  /* array entry */
   1167     hres = ~hres;  /* real index */
   1168     obj2arr(t, cast_uint(hres), value);
   1169   }
   1170 }
   1171 
   1172 
   1173 /*
   1174 ** beware: when using this function you probably need to check a GC
   1175 ** barrier and invalidate the TM cache.
   1176 */
   1177 void luaH_set (lua_State *L, Table *t, const TValue *key, TValue *value) {
   1178   int hres = luaH_pset(t, key, value);
   1179   if (hres != HOK)
   1180     luaH_finishset(L, t, key, value, hres);
   1181 }
   1182 
   1183 
   1184 /*
   1185 ** Ditto for a GC barrier. (No need to invalidate the TM cache, as
   1186 ** integers cannot be keys to metamethods.)
   1187 */
   1188 void luaH_setint (lua_State *L, Table *t, lua_Integer key, TValue *value) {
   1189   unsigned ik = ikeyinarray(t, key);
   1190   if (ik > 0)
   1191     obj2arr(t, ik - 1, value);
   1192   else {
   1193     int ok = rawfinishnodeset(getintfromhash(t, key), value);
   1194     if (!ok) {
   1195       TValue k;
   1196       setivalue(&k, key);
   1197       luaH_newkey(L, t, &k, value);
   1198     }
   1199   }
   1200 }
   1201 
   1202 
   1203 /*
   1204 ** Try to find a boundary in the hash part of table 't'. From the
   1205 ** caller, we know that 'j' is zero or present and that 'j + 1' is
   1206 ** present. We want to find a larger key that is absent from the
   1207 ** table, so that we can do a binary search between the two keys to
   1208 ** find a boundary. We keep doubling 'j' until we get an absent index.
   1209 ** If the doubling would overflow, we try LUA_MAXINTEGER. If it is
   1210 ** absent, we are ready for the binary search. ('j', being max integer,
   1211 ** is larger or equal to 'i', but it cannot be equal because it is
   1212 ** absent while 'i' is present; so 'j > i'.) Otherwise, 'j' is a
   1213 ** boundary. ('j + 1' cannot be a present integer key because it is
   1214 ** not a valid integer in Lua.)
   1215 */
   1216 static lua_Unsigned hash_search (Table *t, lua_Unsigned j) {
   1217   lua_Unsigned i;
   1218   if (j == 0) j++;  /* the caller ensures 'j + 1' is present */
   1219   do {
   1220     i = j;  /* 'i' is a present index */
   1221     if (j <= l_castS2U(LUA_MAXINTEGER) / 2)
   1222       j *= 2;
   1223     else {
   1224       j = LUA_MAXINTEGER;
   1225       if (hashkeyisempty(t, j))  /* t[j] not present? */
   1226         break;  /* 'j' now is an absent index */
   1227       else  /* weird case */
   1228         return j;  /* well, max integer is a boundary... */
   1229     }
   1230   } while (!hashkeyisempty(t, j));  /* repeat until an absent t[j] */
   1231   /* i < j  &&  t[i] present  &&  t[j] absent */
   1232   while (j - i > 1u) {  /* do a binary search between them */
   1233     lua_Unsigned m = (i + j) / 2;
   1234     if (hashkeyisempty(t, m)) j = m;
   1235     else i = m;
   1236   }
   1237   return i;
   1238 }
   1239 
   1240 
   1241 static unsigned int binsearch (Table *array, unsigned int i, unsigned int j) {
   1242   lua_assert(i <= j);
   1243   while (j - i > 1u) {  /* binary search */
   1244     unsigned int m = (i + j) / 2;
   1245     if (arraykeyisempty(array, m)) j = m;
   1246     else i = m;
   1247   }
   1248   return i;
   1249 }
   1250 
   1251 
   1252 /* return a border, saving it as a hint for next call */
   1253 static lua_Unsigned newhint (Table *t, unsigned hint) {
   1254   lua_assert(hint <= t->asize);
   1255   *lenhint(t) = hint;
   1256   return hint;
   1257 }
   1258 
   1259 
   1260 /*
   1261 ** Try to find a border in table 't'. (A 'border' is an integer index
   1262 ** such that t[i] is present and t[i+1] is absent, or 0 if t[1] is absent,
   1263 ** or 'maxinteger' if t[maxinteger] is present.)
   1264 ** If there is an array part, try to find a border there. First try
   1265 ** to find it in the vicinity of the previous result (hint), to handle
   1266 ** cases like 't[#t + 1] = val' or 't[#t] = nil', that move the border
   1267 ** by one entry. Otherwise, do a binary search to find the border.
   1268 ** If there is no array part, or its last element is non empty, the
   1269 ** border may be in the hash part.
   1270 */
   1271 lua_Unsigned luaH_getn (Table *t) {
   1272   unsigned asize = t->asize;
   1273   if (asize > 0) {  /* is there an array part? */
   1274     const unsigned maxvicinity = 4;
   1275     unsigned limit = *lenhint(t);  /* start with the hint */
   1276     if (limit == 0)
   1277       limit = 1;  /* make limit a valid index in the array */
   1278     if (arraykeyisempty(t, limit)) {  /* t[limit] empty? */
   1279       /* there must be a border before 'limit' */
   1280       unsigned i;
   1281       /* look for a border in the vicinity of the hint */
   1282       for (i = 0; i < maxvicinity && limit > 1; i++) {
   1283         limit--;
   1284         if (!arraykeyisempty(t, limit))
   1285           return newhint(t, limit);  /* 'limit' is a border */
   1286       }
   1287       /* t[limit] still empty; search for a border in [0, limit) */
   1288       return newhint(t, binsearch(t, 0, limit));
   1289     }
   1290     else {  /* 'limit' is present in table; look for a border after it */
   1291       unsigned i;
   1292       /* look for a border in the vicinity of the hint */
   1293       for (i = 0; i < maxvicinity && limit < asize; i++) {
   1294         limit++;
   1295         if (arraykeyisempty(t, limit))
   1296           return newhint(t, limit - 1);  /* 'limit - 1' is a border */
   1297       }
   1298       if (arraykeyisempty(t, asize)) {  /* last element empty? */
   1299         /* t[limit] not empty; search for a border in [limit, asize) */
   1300         return newhint(t, binsearch(t, limit, asize));
   1301       }
   1302     }
   1303     /* last element non empty; set a hint to speed up finding that again */
   1304     /* (keys in the hash part cannot be hints) */
   1305     *lenhint(t) = asize;
   1306   }
   1307   /* no array part or t[asize] is not empty; check the hash part */
   1308   lua_assert(asize == 0 || !arraykeyisempty(t, asize));
   1309   if (isdummy(t) || hashkeyisempty(t, asize + 1))
   1310     return asize;  /* 'asize + 1' is empty */
   1311   else  /* 'asize + 1' is also non empty */
   1312     return hash_search(t, asize);
   1313 }
   1314 
   1315 
   1316 
   1317 #if defined(LUA_DEBUG)
   1318 
   1319 /* export this function for the test library */
   1320 
   1321 Node *luaH_mainposition (const Table *t, const TValue *key) {
   1322   return mainpositionTV(t, key);
   1323 }
   1324 
   1325 #endif