cint_array.c

   1 /*
   2  * cint_array.c - routines for arrays of (mostly) consecutive positive integer indices.
   3  */
   4
   5 /*
   6  * Copyright (C) 1986, 1988, 1989, 1991-2013 the Free Software Foundation, Inc.
   7  *
   8  * This file is part of GAWK, the GNU implementation of the
   9  * AWK Programming Language.
  10  *
  11  * GAWK is free software; you can redistribute it and/or modify
  12  * it under the terms of the GNU General Public License as published by
  13  * the Free Software Foundation; either version 3 of the License, or
  14  * (at your option) any later version.
  15  *
  16  * GAWK is distributed in the hope that it will be useful,
  17  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  18  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19  * GNU General Public License for more details.
  20  *
  21  * You should have received a copy of the GNU General Public License
  22  * along with this program; if not, write to the Free Software
  23  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA
  24  */
  25
  26 #include "awk.h"
  27
  28 #define INT32_BIT 32
  29
  30 extern FILE *output_fp;
  31 extern void indent(int indent_level);
  32 extern NODE **is_integer(NODE *symbol, NODE *subs);
  33
  34 /*
  35  * NHAT         ---  maximum size of a leaf array (2^NHAT).
  36  * THRESHOLD    ---  Maximum capacity waste; THRESHOLD >= 2^(NHAT + 1).
  37  */
  38
  39 static int NHAT = 10;
  40 static long THRESHOLD;
  41
  42 /*
  43  * What is the optimium NHAT ? timing results suggest that 10 is a good choice,
  44  * although differences aren't that significant for > 10.
  45  */
  46
  47
  48 static NODE **cint_array_init(NODE *symbol, NODE *subs);
  49 static NODE **is_uinteger(NODE *symbol, NODE *subs);
  50 static NODE **cint_lookup(NODE *symbol, NODE *subs);
  51 static NODE **cint_exists(NODE *symbol, NODE *subs);
  52 static NODE **cint_clear(NODE *symbol, NODE *subs);
  53 static NODE **cint_remove(NODE *symbol, NODE *subs);
  54 static NODE **cint_list(NODE *symbol, NODE *t);
  55 static NODE **cint_copy(NODE *symbol, NODE *newsymb);
  56 static NODE **cint_dump(NODE *symbol, NODE *ndump);
  57 #ifdef ARRAYDEBUG
  58 static void cint_print(NODE *symbol);
  59 #endif
  60
  61 afunc_t cint_array_func[] = {
  62         cint_array_init,
  63         is_uinteger,
  64         null_length,
  65         cint_lookup,
  66         cint_exists,
  67         cint_clear,
  68         cint_remove,
  69         cint_list,
  70         cint_copy,
  71         cint_dump,
  72         (afunc_t) 0,
  73 };
  74
  75 static inline int cint_hash(long k);
  76 static inline NODE **cint_find(NODE *symbol, long k, int h1);
  77
  78 static inline NODE *make_node(NODETYPE type);
  79
  80 static NODE **tree_lookup(NODE *symbol, NODE *tree, long k, int m, long base);
  81 static NODE **tree_exists(NODE *tree, long k);
  82 static void tree_clear(NODE *tree);
  83 static int tree_remove(NODE *symbol, NODE *tree, long k);
  84 static void tree_copy(NODE *newsymb, NODE *tree, NODE *newtree);
  85 static long tree_list(NODE *tree, NODE **list, assoc_kind_t assoc_kind);
  86 static inline NODE **tree_find(NODE *tree, long k, int i);
  87 static void tree_info(NODE *tree, NODE *ndump, const char *aname);
  88 static size_t tree_kilobytes(NODE *tree);
  89 #ifdef ARRAYDEBUG
  90 static void tree_print(NODE *tree, size_t bi, int indent_level);
  91 #endif
  92
  93 static inline NODE **leaf_lookup(NODE *symbol, NODE *array, long k, long size, long base);
  94 static inline NODE **leaf_exists(NODE *array, long k);
  95 static void leaf_clear(NODE *array);
  96 static int leaf_remove(NODE *symbol, NODE *array, long k);
  97 static void leaf_copy(NODE *newsymb, NODE *array, NODE *newarray);
  98 static long leaf_list(NODE *array, NODE **list, assoc_kind_t assoc_kind);
  99 static void leaf_info(NODE *array, NODE *ndump, const char *aname);
 100 #ifdef ARRAYDEBUG
 101 static void leaf_print(NODE *array, size_t bi, int indent_level);
 102 #endif
 103
 104 /* powers of 2 table upto 2^30 */
 105 static const long power_two_table[] = {
 106         1, 2, 4, 8, 16, 32, 64,
 107         128, 256, 512, 1024, 2048, 4096,
 108         8192, 16384, 32768, 65536, 131072, 262144,
 109         524288, 1048576, 2097152, 4194304, 8388608, 16777216,
 110         33554432, 67108864, 134217728, 268435456, 536870912, 1073741824
 111 };
 112
 113
 114 #define ISUINT(a, s)    ((((s)->flags & NUMINT) != 0 || is_integer(a, s) != NULL) \
 115                                     && (s)->numbr >= 0)
 116
 117 /*
 118  * To store 2^n integers, allocate top-level array of size n, elements
 119  * of which are 1-Dimensional (leaf-array) of geometrically increasing
 120  * size (power of 2).
 121  *
 122  *  [0]   -->  [ 0 ]
 123  *  [1]   -->  [ 1 ]
 124  *  |2|   -->  [ 2 | 3 ]
 125  *  |3|   -->  [ 4 | 5 | 6 | 7 ]
 126  *  |.|
 127  *  |k|   -->  [ 2^(k - 1)| ...  | 2^k - 1 ]
 128  *  ...
 129  *
 130  * For a given integer n (> 0), the leaf-array is at 1 + floor(log2(n)).
 131  *
 132  * The idea for the geometrically increasing array sizes is from:
 133  *      Fast Functional Lists, Hash-Lists, Deques and Variable Length Arrays.
 134  *      Bagwell, Phil (2002).
 135  *      http://infoscience.epfl.ch/record/64410/files/techlists.pdf
 136  *
 137  * Disadvantage:
 138  * Worst case memory waste > 99% and will happen when each of the
 139  * leaf arrays contains only a single element. Even with consecutive
 140  * integers, memory waste can be as high as 50%.
 141  *
 142  * Solution: Hashed Array Trees (HATs).
 143  *
 144  */
 145
 146 /* cint_array_init ---  array initialization routine */
 147
 148 static NODE **
 149 cint_array_init(NODE *symbol ATTRIBUTE_UNUSED, NODE *subs ATTRIBUTE_UNUSED)
 150 {
 151         if (symbol == NULL) {
 152                 long newval;
 153                 size_t nelems = (sizeof(power_two_table) / sizeof(power_two_table[0]));
 154
 155                 /* check relevant environment variables */
 156                 if ((newval = getenv_long("NHAT")) > 1 && newval < INT32_BIT)
 157                         NHAT = newval;
 158                 /* don't allow overflow off the end of the table */
 159                 if (NHAT >= nelems)
 160                         NHAT = nelems - 2;
 161                 THRESHOLD = power_two_table[NHAT + 1];
 162         } else
 163                 null_array(symbol);
 164
 165         return (NODE **) ! NULL;
 166 }
 167
 168
 169 /* is_uinteger --- test if the subscript is an integer >= 0 */
 170
 171 NODE **
 172 is_uinteger(NODE *symbol, NODE *subs)
 173 {
 174         if (is_integer(symbol, subs) != NULL && subs->numbr >= 0)
 175                 return (NODE **) ! NULL;
 176         return NULL;
 177 }
 178
 179
 180 /* cint_lookup --- Find the subscript in the array; Install it if it isn't there. */
 181
 182 static NODE **
 183 cint_lookup(NODE *symbol, NODE *subs)
 184 {
 185         NODE **lhs;
 186         long k;
 187         int h1 = -1, m, li;
 188         NODE *tn, *xn;
 189         long cint_size, capacity;
 190
 191         k = -1;
 192         if (ISUINT(symbol, subs)) {
 193                 k = subs->numbr;        /* k >= 0 */
 194                 h1 = cint_hash(k);      /* h1 >= NHAT */
 195                 if ((lhs = cint_find(symbol, k, h1)) != NULL)
 196                         return lhs;
 197         }
 198         xn = symbol->xarray;
 199         if (xn != NULL && (lhs = xn->aexists(xn, subs)) != NULL)
 200                 return lhs;
 201
 202         /* It's not there, install it */
 203
 204         if (k < 0)
 205                 goto xinstall;
 206
 207         m = h1 - 1;     /* m >= (NHAT- 1) */
 208
 209         /* Estimate capacity upper bound.
 210          * capacity upper bound = current capacity + leaf array size.
 211          */
 212         li = m > NHAT ? m : NHAT;
 213         while (li >= NHAT) {
 214                 /* leaf-array of a HAT */
 215                 li = (li + 1) / 2;
 216         }
 217         capacity = symbol->array_capacity + power_two_table[li];
 218
 219         cint_size = (xn == NULL) ? symbol->table_size
 220                                 : (symbol->table_size - xn->table_size);
 221         assert(cint_size >= 0);
 222         if ((capacity - cint_size) > THRESHOLD)
 223                 goto xinstall;
 224
 225         if (symbol->nodes == NULL) {
 226                 symbol->array_capacity = 0;
 227                 assert(symbol->table_size == 0);
 228
 229                 /* nodes[0] .. nodes[NHAT- 1] not used */
 230                 emalloc(symbol->nodes, NODE **, INT32_BIT * sizeof(NODE *), "cint_lookup");
 231                 memset(symbol->nodes, '\0', INT32_BIT * sizeof(NODE *));
 232         }
 233
 234         symbol->table_size++;   /* one more element in array */
 235
 236         tn = symbol->nodes[h1];
 237         if (tn == NULL) {
 238                 tn = make_node(Node_array_tree);
 239                 symbol->nodes[h1] = tn;
 240         }
 241
 242         if (m < NHAT)
 243                 return tree_lookup(symbol, tn, k, NHAT, 0);
 244         return tree_lookup(symbol, tn, k, m, power_two_table[m]);
 245
 246 xinstall:
 247
 248         symbol->table_size++;
 249         if (xn == NULL) {
 250                 xn = symbol->xarray = make_array();
 251                 xn->vname = symbol->vname;      /* shallow copy */
 252
 253                 /*
 254                  * Avoid using assoc_lookup(xn, subs) which may lead
 255                  * to infinite recursion.
 256                  */
 257
 258                 if (is_integer(xn, subs))
 259                         xn->array_funcs = int_array_func;
 260                 else
 261                         xn->array_funcs = str_array_func;
 262                 xn->flags |= XARRAY;
 263         }
 264         return xn->alookup(xn, subs);
 265 }
 266
 267
 268 /* cint_exists --- test whether an index is in the array or not. */
 269
 270 static NODE **
 271 cint_exists(NODE *symbol, NODE *subs)
 272 {
 273         NODE *xn;
 274
 275         if (ISUINT(symbol, subs)) {
 276                 long k = subs->numbr;
 277                 NODE **lhs;
 278                 if ((lhs = cint_find(symbol, k, cint_hash(k))) != NULL)
 279                         return lhs;
 280         }
 281         if ((xn = symbol->xarray) == NULL)
 282                 return NULL;
 283         return xn->aexists(xn, subs);
 284 }
 285
 286
 287 /* cint_clear --- flush all the values in symbol[] */
 288
 289 static NODE **
 290 cint_clear(NODE *symbol, NODE *subs ATTRIBUTE_UNUSED)
 291 {
 292         size_t i;
 293         NODE *tn;
 294
 295         assert(symbol->nodes != NULL);
 296
 297         if (symbol->xarray != NULL) {
 298                 NODE *xn = symbol->xarray;
 299                 assoc_clear(xn);
 300                 freenode(xn);
 301                 symbol->xarray = NULL;
 302         }
 303
 304         for (i = NHAT; i < INT32_BIT; i++) {
 305                 tn = symbol->nodes[i];
 306                 if (tn != NULL) {
 307                         tree_clear(tn);
 308                         freenode(tn);
 309                 }
 310         }
 311
 312         efree(symbol->nodes);
 313         symbol->ainit(symbol, NULL);    /* re-initialize symbol */
 314         return NULL;
 315 }
 316
 317
 318 /* cint_remove --- remove an index from the array */
 319
 320 static NODE **
 321 cint_remove(NODE *symbol, NODE *subs)
 322 {
 323         long k;
 324         int h1;
 325         NODE *tn, *xn = symbol->xarray;
 326
 327         if (symbol->table_size == 0)
 328                 return NULL;
 329
 330         if (! ISUINT(symbol, subs))
 331                 goto xremove;
 332
 333         assert(symbol->nodes != NULL);
 334
 335         k = subs->numbr;
 336         h1 = cint_hash(k);
 337         tn = symbol->nodes[h1];
 338         if (tn == NULL || ! tree_remove(symbol, tn, k))
 339                 goto xremove;
 340
 341         if (tn->table_size == 0) {
 342                 freenode(tn);
 343                 symbol->nodes[h1] = NULL;
 344         }
 345
 346         symbol->table_size--;
 347
 348         if (xn == NULL && symbol->table_size == 0) {
 349                 efree(symbol->nodes);
 350                 symbol->ainit(symbol, NULL);    /* re-initialize array 'symbol' */
 351         } else if(xn != NULL && symbol->table_size == xn->table_size) {
 352                 /* promote xn to symbol */
 353
 354                 xn->flags &= ~XARRAY;
 355                 xn->parent_array = symbol->parent_array;
 356                 efree(symbol->nodes);
 357                 *symbol = *xn;
 358                 freenode(xn);
 359         }
 360
 361         return (NODE **) ! NULL;
 362
 363 xremove:
 364         xn = symbol->xarray;
 365         if (xn == NULL || xn->aremove(xn, subs) == NULL)
 366                 return NULL;
 367         if (xn->table_size == 0) {
 368                 freenode(xn);
 369                 symbol->xarray = NULL;
 370         }
 371         symbol->table_size--;
 372         assert(symbol->table_size > 0);
 373
 374         return (NODE **) ! NULL;
 375 }
 376
 377
 378 /* cint_copy --- duplicate input array "symbol" */
 379
 380 static NODE **
 381 cint_copy(NODE *symbol, NODE *newsymb)
 382 {
 383         NODE **old, **new;
 384         size_t i;
 385
 386         assert(symbol->nodes != NULL);
 387
 388         /* allocate new table */
 389         emalloc(new, NODE **, INT32_BIT * sizeof(NODE *), "cint_copy");
 390         memset(new, '\0', INT32_BIT * sizeof(NODE *));
 391
 392         old = symbol->nodes;
 393         for (i = NHAT; i < INT32_BIT; i++) {
 394                 if (old[i] == NULL)
 395                         continue;
 396                 new[i] = make_node(Node_array_tree);
 397                 tree_copy(newsymb, old[i], new[i]);
 398         }
 399
 400         if (symbol->xarray != NULL) {
 401                 NODE *xn, *n;
 402                 xn = symbol->xarray;
 403                 n = make_array();
 404                 n->vname = newsymb->vname;
 405                 (void) xn->acopy(xn, n);
 406                 newsymb->xarray = n;
 407         } else
 408                 newsymb->xarray = NULL;
 409
 410         newsymb->nodes = new;
 411         newsymb->table_size = symbol->table_size;
 412         newsymb->array_capacity = symbol->array_capacity;
 413         newsymb->flags = symbol->flags;
 414
 415         return NULL;
 416 }
 417
 418
 419 /* cint_list --- return a list of items */
 420
 421 static NODE**
 422 cint_list(NODE *symbol, NODE *t)
 423 {
 424         NODE **list = NULL;
 425         NODE *tn, *xn;
 426         unsigned long k = 0, num_elems, list_size;
 427         size_t j, ja, jd;
 428         int elem_size = 1;
 429         assoc_kind_t assoc_kind;
 430
 431         num_elems = symbol->table_size;
 432         if (num_elems == 0)
 433                 return NULL;
 434         assoc_kind = (assoc_kind_t) t->flags;
 435         if ((assoc_kind & (AINDEX|AVALUE|ADELETE)) == (AINDEX|ADELETE))
 436                 num_elems = 1;
 437
 438         if ((assoc_kind & (AINDEX|AVALUE)) == (AINDEX|AVALUE))
 439                 elem_size = 2;
 440         list_size = num_elems * elem_size;
 441
 442         if (symbol->xarray != NULL) {
 443                 xn = symbol->xarray;
 444                 list = xn->alist(xn, t);
 445                 assert(list != NULL);
 446                 assoc_kind &= ~(AASC|ADESC);
 447                 t->flags = (unsigned int) assoc_kind;
 448                 if (num_elems == 1 || num_elems == xn->table_size)
 449                         return list;
 450                 erealloc(list, NODE **, list_size * sizeof(NODE *), "cint_list");
 451                 k = elem_size * xn->table_size;
 452         } else
 453                 emalloc(list, NODE **, list_size * sizeof(NODE *), "cint_list");
 454
 455         if ((assoc_kind & AINUM) == 0) {
 456                 /* not sorting by "index num" */
 457                 assoc_kind &= ~(AASC|ADESC);
 458                 t->flags = (unsigned int) assoc_kind;
 459         }
 460
 461         /* populate it with index in ascending or descending order */
 462
 463         for (ja = NHAT, jd = INT32_BIT - 1; ja < INT32_BIT && jd >= NHAT; ) {
 464                 j = (assoc_kind & ADESC) != 0 ? jd-- : ja++;
 465                 tn = symbol->nodes[j];
 466                 if (tn == NULL)
 467                         continue;
 468                 k += tree_list(tn, list + k, assoc_kind);
 469                 if (k >= list_size)
 470                         return list;
 471         }
 472         return list;
 473 }
 474
 475
 476 /* cint_dump --- dump array info */
 477
 478 static NODE **
 479 cint_dump(NODE *symbol, NODE *ndump)
 480 {
 481         NODE *tn, *xn = NULL;
 482         int indent_level;
 483         size_t i;
 484         long cint_size = 0, xsize = 0;
 485         AWKNUM kb = 0;
 486         extern AWKNUM int_kilobytes(NODE *symbol);
 487         extern AWKNUM str_kilobytes(NODE *symbol);
 488
 489         indent_level = ndump->alevel;
 490
 491         if (symbol->xarray != NULL) {
 492                 xn = symbol->xarray;
 493                 xsize = xn->table_size;
 494         }
 495         cint_size = symbol->table_size - xsize;
 496
 497         if ((symbol->flags & XARRAY) == 0)
 498                 fprintf(output_fp, "%s `%s'\n",
 499                         (symbol->parent_array == NULL) ? "array" : "sub-array",
 500                         array_vname(symbol));
 501         indent_level++;
 502         indent(indent_level);
 503         fprintf(output_fp, "array_func: cint_array_func\n");
 504         if (symbol->flags != 0) {
 505                 indent(indent_level);
 506                 fprintf(output_fp, "flags: %s\n", flags2str(symbol->flags));
 507         }
 508         indent(indent_level);
 509         fprintf(output_fp, "NHAT: %d\n", NHAT);
 510         indent(indent_level);
 511         fprintf(output_fp, "THRESHOLD: %ld\n", THRESHOLD);
 512         indent(indent_level);
 513         fprintf(output_fp, "table_size: %ld (total), %ld (cint), %ld (int + str)\n",
 514                                 symbol->table_size, cint_size, xsize);
 515         indent(indent_level);
 516         fprintf(output_fp, "array_capacity: %lu\n", (unsigned long) symbol->array_capacity);
 517         indent(indent_level);
 518         fprintf(output_fp, "Load Factor: %.2g\n", (AWKNUM) cint_size / symbol->array_capacity);
 519
 520         for (i = NHAT; i < INT32_BIT; i++) {
 521                 tn = symbol->nodes[i];
 522                 if (tn == NULL)
 523                         continue;
 524                 /* Node_array_tree  + HAT */
 525                 kb += (sizeof(NODE) + tree_kilobytes(tn)) / 1024.0;
 526         }
 527         kb += (INT32_BIT * sizeof(NODE *)) / 1024.0;    /* symbol->nodes */
 528         kb += (symbol->array_capacity * sizeof(NODE *)) / 1024.0;       /* value nodes in Node_array_leaf(s) */
 529         if (xn != NULL) {
 530                 if (xn->array_funcs == int_array_func)
 531                         kb += int_kilobytes(xn);
 532                 else
 533                         kb += str_kilobytes(xn);
 534         }
 535
 536         indent(indent_level);
 537         fprintf(output_fp, "memory: %.2g kB (total)\n", kb);
 538
 539         /* dump elements */
 540
 541         if (ndump->adepth >= 0) {
 542                 const char *aname;
 543
 544                 fprintf(output_fp, "\n");
 545                 aname = make_aname(symbol);
 546                 for (i = NHAT; i < INT32_BIT; i++) {
 547                         tn = symbol->nodes[i];
 548                         if (tn != NULL)
 549                                 tree_info(tn, ndump, aname);
 550                 }
 551         }
 552
 553         if (xn != NULL) {
 554                 fprintf(output_fp, "\n");
 555                 xn->adump(xn, ndump);
 556         }
 557
 558 #ifdef ARRAYDEBUG
 559         if (ndump->adepth < -999)
 560                 cint_print(symbol);
 561 #endif
 562
 563         return NULL;
 564 }
 565
 566
 567 /* cint_hash --- locate the HAT for a given number 'k' */
 568
 569 static inline int
 570 cint_hash(long k)
 571 {
 572         uint32_t num, r, shift;
 573
 574         assert(k >= 0);
 575         if (k == 0)
 576                 return NHAT;
 577         num = k;
 578
 579         /* Find the Floor(log base 2 of 32-bit integer) */
 580
 581         /*
 582          * Warren Jr., Henry S. (2002). Hacker's Delight.
 583          * Addison Wesley. pp. pp. 215. ISBN 978-0201914658.
 584          *
 585          *      r = 0;
 586          *      if (num >= 1<<16) { num >>= 16; r += 16; }
 587          *      if (num >= 1<< 8) { num >>=  8; r +=  8; }
 588          *      if (num >= 1<< 4) { num >>=  4; r +=  4; }
 589          *      if (num >= 1<< 2) { num >>=  2; r +=  2; }
 590          *      if (num >= 1<< 1) {             r +=  1; }
 591          */
 592
 593
 594         /*
 595          * Slightly different code copied from:
 596          *
 597          * http://www-graphics.stanford.edu/~seander/bithacks.html
 598          * Bit Twiddling Hacks
 599          * By Sean Eron Anderson
 600          * seander@cs.stanford.edu
 601          * Individually, the code snippets here are in the public domain
 602          * (unless otherwise noted) — feel free to use them however you please.
 603          * The aggregate collection and descriptions are © 1997-2005
 604          * Sean Eron Anderson. The code and descriptions are distributed in the
 605          * hope that they will be useful, but WITHOUT ANY WARRANTY and without
 606          * even the implied warranty of merchantability or fitness for a particular
 607          * purpose.
 608          *
 609          */
 610
 611         r = (num > 0xFFFF) << 4; num >>= r;
 612         shift = (num > 0xFF) << 3; num >>= shift; r |= shift;
 613         shift = (num > 0x0F) << 2; num >>= shift; r |= shift;
 614         shift = (num > 0x03) << 1; num >>= shift; r |= shift;
 615         r |= (num >> 1);
 616
 617         /* We use a single HAT for 0 <= num < 2^NHAT */
 618         if (r < NHAT)
 619                 return NHAT;
 620
 621         return (1 + r);
 622 }
 623
 624
 625 /* cint_find --- locate the integer subscript */
 626
 627 static inline NODE **
 628 cint_find(NODE *symbol, long k, int h1)
 629 {
 630         NODE *tn;
 631
 632         if (symbol->nodes == NULL || (tn = symbol->nodes[h1]) == NULL)
 633                 return NULL;
 634         return tree_exists(tn, k);
 635 }
 636
 637
 638 #ifdef ARRAYDEBUG
 639
 640 /* cint_print --- print structural info */
 641
 642 static void
 643 cint_print(NODE *symbol)
 644 {
 645         NODE *tn;
 646         size_t i;
 647
 648         fprintf(output_fp, "I[%4lu:%-4lu]\n", (unsigned long) INT32_BIT,
 649                                 (unsigned long) symbol->table_size);
 650         for (i = NHAT; i < INT32_BIT; i++) {
 651                 tn = symbol->nodes[i];
 652                 if (tn == NULL)
 653                         continue;
 654                 tree_print(tn, i, 1);
 655         }
 656 }
 657
 658 #endif
 659
 660
 661 /*------------------------ Hashed Array Trees -----------------------------*/
 662
 663 /*
 664  * HATs: Hashed Array Trees
 665  * Fast variable-length arrays
 666  * Edward Sitarski
 667  * http://www.drdobbs.com/architecture-and-design/184409965
 668  *
 669  *  HAT has a top-level array containing a power of two
 670  *  number of leaf arrays. All leaf arrays are the same size as the
 671  *  top-level array. A full HAT can hold n^2 elements,
 672  *  where n (some power of 2) is the size of each leaf array.
 673  *  [i/n][i & (n - 1)] locates the `i th' element in a HAT.
 674  *
 675  */
 676
 677 /*
 678  *  A half HAT is defined here as a HAT with a top-level array of size n^2/2
 679  *  and holds the first n^2/2 elements.
 680  *
 681  *   1. 2^8 elements can be stored in a full HAT of size 2^4.
 682  *   2. 2^9 elements can be stored in a half HAT of size 2^5.
 683  *   3. When the number of elements is some power of 2, it
 684  *      can be stored in a full or a half HAT.
 685  *   4. When the number of elements is some power of 2, it
 686  *      can be stored in a HAT (full or half) with HATs as leaf elements
 687  *      (full or half),  and so on (e.g. 2^8 elements in a HAT of size 2^4 (top-level
 688  *      array dimension) with each leaf array being a HAT of size 2^2).
 689  *
 690  *  IMPLEMENTATION DETAILS:
 691  *    1. A HAT of 2^12 elements needs 2^6 house-keeping NODEs
 692  *       of Node_array_leaf.
 693  *
 694  *    2. A HAT of HATS of 2^12 elements needs
 695  *       2^6 * (1 Node_array_tree + 2^3 Node_array_leaf)
 696  *       ~ 2^9 house-keeping NODEs.
 697  *
 698  *    3. When a leaf array (or leaf HAT) becomes empty, the memory
 699  *       is deallocated, and when there is no leaf array (or leaf HAT) left,
 700  *       the HAT is deleted.
 701  *
 702  *    4. A HAT stores the base (first) element, and locates the leaf array/HAT
 703  *       for the `i th' element using integer division
 704  *       (i - base)/n where n is the size of the top-level array.
 705  *
 706  */
 707
 708 /* make_node --- initialize a NODE */
 709
 710 static inline NODE *
 711 make_node(NODETYPE type)
 712 {
 713         NODE *n;
 714         getnode(n);
 715         memset(n, '\0', sizeof(NODE));
 716         n->type = type;
 717         return n;
 718 }
 719
 720
 721 /* tree_lookup --- Find an integer subscript in a HAT; Install it if it isn't there */
 722
 723 static NODE **
 724 tree_lookup(NODE *symbol, NODE *tree, long k, int m, long base)
 725 {
 726         NODE **lhs;
 727         NODE *tn;
 728         int i, n;
 729         size_t size;
 730         long num = k;
 731
 732         /*
 733          * HAT size (size of Top & Leaf array) = 2^n
 734          * where n = Floor ((m + 1)/2). For an odd value of m,
 735          * only the first half of the HAT is needed.
 736          */
 737
 738         n = (m + 1) / 2;
 739
 740         if (tree->table_size == 0) {
 741                 size_t actual_size;
 742                 NODE **table;
 743
 744                 assert(tree->nodes == NULL);
 745
 746                 /* initialize top-level array */
 747                 size = actual_size = power_two_table[n];
 748                 tree->array_base = base;
 749                 tree->array_size = size;
 750                 tree->table_size = 0;   /* # of elements in the array */
 751                 if (n > m/2) {
 752                         /* only first half of the array used */
 753                         actual_size /= 2;
 754                         tree->flags |= HALFHAT;
 755                 }
 756                 emalloc(table, NODE **, actual_size * sizeof(NODE *), "tree_lookup");
 757                 memset(table, '\0', actual_size * sizeof(NODE *));
 758                 tree->nodes = table;
 759         } else
 760                 size = tree->array_size;
 761
 762         num -= tree->array_base;
 763         i = num / size; /* top-level array index */
 764         assert(i >= 0);
 765
 766         if ((lhs = tree_find(tree, k, i)) != NULL)
 767                 return lhs;
 768
 769         /* It's not there, install it */
 770
 771         tree->table_size++;
 772         base += (size * i);
 773         tn = tree->nodes[i];
 774         if (n > NHAT) {
 775                 if (tn == NULL)
 776                         tn = tree->nodes[i] = make_node(Node_array_tree);
 777                 return tree_lookup(symbol, tn, k, n, base);
 778         } else {
 779                 if (tn == NULL)
 780                         tn = tree->nodes[i] = make_node(Node_array_leaf);
 781                 return leaf_lookup(symbol, tn, k, size, base);
 782         }
 783 }
 784
 785
 786 /* tree_exists --- test whether integer subscript `k' exists or not */
 787
 788 static NODE **
 789 tree_exists(NODE *tree, long k)
 790 {
 791         int i;
 792         NODE *tn;
 793
 794         i = (k - tree->array_base) / tree->array_size;
 795         assert(i >= 0);
 796         tn = tree->nodes[i];
 797         if (tn == NULL)
 798                 return NULL;
 799         if (tn->type == Node_array_tree)
 800                 return tree_exists(tn, k);
 801         return leaf_exists(tn, k);
 802 }
 803
 804 /* tree_clear --- flush all the values */
 805
 806 static void
 807 tree_clear(NODE *tree)
 808 {
 809         NODE *tn;
 810         size_t  j, hsize;
 811
 812         hsize = tree->array_size;
 813         if ((tree->flags & HALFHAT) != 0)
 814                 hsize /= 2;
 815
 816         for (j = 0; j < hsize; j++) {
 817                 tn = tree->nodes[j];
 818                 if (tn == NULL)
 819                         continue;
 820                 if (tn->type == Node_array_tree)
 821                         tree_clear(tn);
 822                 else
 823                         leaf_clear(tn);
 824                 freenode(tn);
 825         }
 826
 827         efree(tree->nodes);
 828         memset(tree, '\0', sizeof(NODE));
 829         tree->type = Node_array_tree;
 830 }
 831
 832
 833 /* tree_remove --- If the integer subscript is in the HAT, remove it */
 834
 835 static int
 836 tree_remove(NODE *symbol, NODE *tree, long k)
 837 {
 838         int i;
 839         NODE *tn;
 840
 841         i = (k - tree->array_base) / tree->array_size;
 842         assert(i >= 0);
 843         tn = tree->nodes[i];
 844         if (tn == NULL)
 845                 return false;
 846
 847         if (tn->type == Node_array_tree
 848                         && ! tree_remove(symbol, tn, k))
 849                 return false;
 850         else if (tn->type == Node_array_leaf
 851                         && ! leaf_remove(symbol, tn, k))
 852                 return false;
 853
 854         if (tn->table_size == 0) {
 855                 freenode(tn);
 856                 tree->nodes[i] = NULL;
 857         }
 858
 859         /* one less item in array */
 860         if (--tree->table_size == 0) {
 861                 efree(tree->nodes);
 862                 memset(tree, '\0', sizeof(NODE));
 863                 tree->type = Node_array_tree;
 864         }
 865         return true;
 866 }
 867
 868
 869 /* tree_find --- locate an interger subscript in the HAT */
 870
 871 static inline NODE **
 872 tree_find(NODE *tree, long k, int i)
 873 {
 874         NODE *tn;
 875
 876         assert(tree->nodes != NULL);
 877         tn = tree->nodes[i];
 878         if (tn != NULL) {
 879                 if (tn->type == Node_array_tree)
 880                         return tree_exists(tn, k);
 881                 return leaf_exists(tn, k);
 882         }
 883         return NULL;
 884 }
 885
 886
 887 /* tree_list --- return a list of items in the HAT */
 888
 889 static long
 890 tree_list(NODE *tree, NODE **list, assoc_kind_t assoc_kind)
 891 {
 892         NODE *tn;
 893         size_t j, cj, hsize;
 894         long k = 0;
 895
 896         assert(list != NULL);
 897
 898         hsize = tree->array_size;
 899         if ((tree->flags & HALFHAT) != 0)
 900                 hsize /= 2;
 901
 902         for (j = 0; j < hsize; j++) {
 903                 cj = (assoc_kind & ADESC) != 0 ? (hsize - 1 - j) : j;
 904                 tn = tree->nodes[cj];
 905                 if (tn == NULL)
 906                         continue;
 907                 if (tn->type == Node_array_tree)
 908                         k += tree_list(tn, list + k, assoc_kind);
 909                 else
 910                         k += leaf_list(tn, list + k, assoc_kind);
 911                 if ((assoc_kind & ADELETE) != 0 && k >= 1)
 912                         return k;
 913         }
 914         return k;
 915 }
 916
 917
 918 /* tree_copy --- duplicate a HAT */
 919
 920 static void
 921 tree_copy(NODE *newsymb, NODE *tree, NODE *newtree)
 922 {
 923         NODE **old, **new;
 924         size_t j, hsize;
 925
 926         hsize = tree->array_size;
 927         if ((tree->flags & HALFHAT) != 0)
 928                 hsize /= 2;
 929
 930         emalloc(new, NODE **, hsize * sizeof(NODE *), "tree_copy");
 931         memset(new, '\0', hsize * sizeof(NODE *));
 932         newtree->nodes = new;
 933         newtree->array_base = tree->array_base;
 934         newtree->array_size = tree->array_size;
 935         newtree->table_size = tree->table_size;
 936         newtree->flags = tree->flags;
 937
 938         old = tree->nodes;
 939         for (j = 0; j < hsize; j++) {
 940                 if (old[j] == NULL)
 941                         continue;
 942                 if (old[j]->type == Node_array_tree) {
 943                         new[j] = make_node(Node_array_tree);
 944                         tree_copy(newsymb, old[j], new[j]);
 945                 } else {
 946                         new[j] = make_node(Node_array_leaf);
 947                         leaf_copy(newsymb, old[j], new[j]);
 948                 }
 949         }
 950 }
 951
 952
 953 /* tree_info --- print index, value info */
 954
 955 static void
 956 tree_info(NODE *tree, NODE *ndump, const char *aname)
 957 {
 958         NODE *tn;
 959         size_t j, hsize;
 960
 961         hsize = tree->array_size;
 962         if ((tree->flags & HALFHAT) != 0)
 963                 hsize /= 2;
 964
 965         for (j = 0; j < hsize; j++) {
 966                 tn = tree->nodes[j];
 967                 if (tn == NULL)
 968                         continue;
 969                 if (tn->type == Node_array_tree)
 970                         tree_info(tn, ndump, aname);
 971                 else
 972                         leaf_info(tn, ndump, aname);
 973         }
 974 }
 975
 976
 977 /* tree_kilobytes --- calculate memory consumption of a HAT */
 978
 979 static size_t
 980 tree_kilobytes(NODE *tree)
 981 {
 982         NODE *tn;
 983         size_t j, hsize;
 984         size_t sz = 0;
 985
 986         hsize = tree->array_size;
 987         if ((tree->flags & HALFHAT) != 0)
 988                 hsize /= 2;
 989         for (j = 0; j < hsize; j++) {
 990                 tn = tree->nodes[j];
 991                 if (tn == NULL)
 992                         continue;
 993                 sz += sizeof(NODE);     /* Node_array_tree or Node_array_leaf */
 994                 if (tn->type == Node_array_tree)
 995                         sz += tree_kilobytes(tn);
 996         }
 997         sz += hsize * sizeof(NODE *);   /* tree->nodes */
 998         return sz;
 999 }
1000
1001 #ifdef ARRAYDEBUG
1002
1003 /* tree_print --- print the HAT structures */
1004
1005 static void
1006 tree_print(NODE *tree, size_t bi, int indent_level)
1007 {
1008         NODE *tn;
1009         size_t j, hsize;
1010
1011         indent(indent_level);
1012
1013         hsize = tree->array_size;
1014         if ((tree->flags & HALFHAT) != 0)
1015                 hsize /= 2;
1016         fprintf(output_fp, "%4lu:%s[%4lu:%-4lu]\n",
1017                         (unsigned long) bi,
1018                         (tree->flags & HALFHAT) != 0 ? "HH" : "H",
1019                         (unsigned long) hsize, (unsigned long) tree->table_size);
1020
1021         for (j = 0; j < hsize; j++) {
1022                 tn = tree->nodes[j];
1023                 if (tn == NULL)
1024                         continue;
1025                 if (tn->type == Node_array_tree)
1026                         tree_print(tn, j, indent_level + 1);
1027                 else
1028                         leaf_print(tn, j, indent_level + 1);
1029         }
1030 }
1031 #endif
1032
1033 /*--------------------- leaf (linear 1-D) array --------------------*/
1034
1035 /*
1036  * leaf_lookup --- find an integer subscript in the array; Install it if
1037  *      it isn't there.
1038  */
1039
1040 static inline NODE **
1041 leaf_lookup(NODE *symbol, NODE *array, long k, long size, long base)
1042 {
1043         NODE **lhs;
1044
1045         if (array->nodes == NULL) {
1046                 array->table_size = 0;  /* sanity */
1047                 array->array_size = size;
1048                 array->array_base = base;
1049                 emalloc(array->nodes, NODE **, size * sizeof(NODE *), "leaf_lookup");
1050                 memset(array->nodes, '\0', size * sizeof(NODE *));
1051                 symbol->array_capacity += size;
1052         }
1053
1054         lhs = array->nodes + (k - base); /* leaf element */
1055         if (*lhs == NULL) {
1056                 array->table_size++;    /* one more element in leaf array */
1057                 *lhs = dupnode(Nnull_string);
1058         }
1059         return lhs;
1060 }
1061
1062
1063 /* leaf_exists --- check if the array contains an integer subscript */
1064
1065 static inline NODE **
1066 leaf_exists(NODE *array, long k)
1067 {
1068         NODE **lhs;
1069         lhs = array->nodes + (k - array->array_base);
1070         return (*lhs != NULL) ? lhs : NULL;
1071 }
1072
1073
1074 /* leaf_clear --- flush all values in the array */
1075
1076 static void
1077 leaf_clear(NODE *array)
1078 {
1079         long i, size = array->array_size;
1080         NODE *r;
1081
1082         for (i = 0; i < size; i++) {
1083                 r = array->nodes[i];
1084                 if (r == NULL)
1085                         continue;
1086                 if (r->type == Node_var_array) {
1087                         assoc_clear(r);         /* recursively clear all sub-arrays */
1088                         efree(r->vname);
1089                         freenode(r);
1090                 } else
1091                         unref(r);
1092         }
1093         efree(array->nodes);
1094         array->nodes = NULL;
1095         array->array_size = array->table_size = 0;
1096 }
1097
1098
1099 /* leaf_remove --- remove an integer subscript from the array */
1100
1101 static int
1102 leaf_remove(NODE *symbol, NODE *array, long k)
1103 {
1104         NODE **lhs;
1105
1106         lhs = array->nodes + (k - array->array_base);
1107         if (*lhs == NULL)
1108                 return false;
1109         *lhs = NULL;
1110         if (--array->table_size == 0) {
1111                 efree(array->nodes);
1112                 array->nodes = NULL;
1113                 symbol->array_capacity -= array->array_size;
1114                 array->array_size = 0;  /* sanity */
1115         }
1116         return true;
1117 }
1118
1119
1120 /* leaf_copy --- duplicate a leaf array */
1121
1122 static void
1123 leaf_copy(NODE *newsymb, NODE *array, NODE *newarray)
1124 {
1125         NODE **old, **new;
1126         long size, i;
1127
1128         size = array->array_size;
1129         emalloc(new, NODE **, size * sizeof(NODE *), "leaf_copy");
1130         memset(new, '\0', size * sizeof(NODE *));
1131         newarray->nodes = new;
1132         newarray->array_size = size;
1133         newarray->array_base = array->array_base;
1134         newarray->flags = array->flags;
1135         newarray->table_size = array->table_size;
1136
1137         old = array->nodes;
1138         for (i = 0; i < size; i++) {
1139                 if (old[i] == NULL)
1140                         continue;
1141                 if (old[i]->type == Node_val)
1142                         new[i] = dupnode(old[i]);
1143                 else {
1144                         NODE *r;
1145                         r = make_array();
1146                         r->vname = estrdup(old[i]->vname, strlen(old[i]->vname));
1147                         r->parent_array = newsymb;
1148                         new[i] = assoc_copy(old[i], r);
1149                 }
1150         }
1151 }
1152
1153
1154 /* leaf_list --- return a list of items */
1155
1156 static long
1157 leaf_list(NODE *array, NODE **list, assoc_kind_t assoc_kind)
1158 {
1159         NODE *r, *subs;
1160         long num, i, ci, k = 0;
1161         long size = array->array_size;
1162         static char buf[100];
1163
1164         for (i = 0; i < size; i++) {
1165                 ci = (assoc_kind & ADESC) != 0 ? (size - 1 - i) : i;
1166                 r = array->nodes[ci];
1167                 if (r == NULL)
1168                         continue;
1169
1170                 /* index */
1171                 num = array->array_base + ci;
1172                 if ((assoc_kind & AISTR) != 0) {
1173                         sprintf(buf, "%ld", num);
1174                         subs = make_string(buf, strlen(buf));
1175                         subs->numbr = num;
1176                         subs->flags |= (NUMCUR|NUMINT);
1177                 } else {
1178                         subs = make_number((AWKNUM) num);
1179                         subs->flags |= (INTIND|NUMINT);
1180                 }
1181                 list[k++] = subs;
1182
1183                 /* value */
1184                 if ((assoc_kind & AVALUE) != 0) {
1185                         if (r->type == Node_val) {
1186                                 if ((assoc_kind & AVNUM) != 0)
1187                                         (void) force_number(r);
1188                                 else if ((assoc_kind & AVSTR) != 0)
1189                                         r = force_string(r);
1190                         }
1191                         list[k++] = r;
1192                 }
1193                 if ((assoc_kind & ADELETE) != 0 && k >= 1)
1194                         return k;
1195         }
1196
1197         return k;
1198 }
1199
1200
1201 /* leaf_info --- print index, value info */
1202
1203 static void
1204 leaf_info(NODE *array, NODE *ndump, const char *aname)
1205 {
1206         NODE *subs, *val;
1207         size_t i, size;
1208
1209         size = array->array_size;
1210
1211         subs = make_number((AWKNUM) 0.0);
1212         subs->flags |= (INTIND|NUMINT);
1213         for (i = 0; i < size; i++) {
1214                 val = array->nodes[i];
1215                 if (val == NULL)
1216                         continue;
1217                 subs->numbr = array->array_base + i;
1218                 assoc_info(subs, val, ndump, aname);
1219         }
1220         unref(subs);
1221 }
1222
1223 #ifdef ARRAYDEBUG
1224
1225 /* leaf_print --- print the leaf-array structure */
1226
1227
1228 static void
1229 leaf_print(NODE *array, size_t bi, int indent_level)
1230 {
1231         indent(indent_level);
1232         fprintf(output_fp, "%4lu:L[%4lu:%-4lu]\n",
1233                         (unsigned long) bi,
1234                         (unsigned long) array->array_size,
1235                         (unsigned long) array->table_size);
1236 }
1237 #endif