compilers/imcc/symreg.c

   1 /*
   2  * Copyright (C) 2002-2008, The Perl Foundation.
   3  * $Id$
   4  */
   5
   6 /*
   7
   8 =head1 NAME
   9
  10 compilers/imcc/symreg.c
  11
  12 =head1 DESCRIPTION
  13
  14 imcc symbol handling
  15
  16 XXX: SymReg stuff has become overused. SymReg should be for symbolic
  17 registers, reg allocation, etc. but we are now using it for extensive
  18 symbol table management. Need to convert much of this over the use Symbol
  19 and SymbolTable (see symbol.h and symbol.c)
  20
  21 =head2 Functions
  22
  23 =over 4
  24
  25 =cut
  26
  27 */
  28
  29
  30 #include "imc.h"
  31
  32 /* Globals: */
  33 /* Code: */
  34
  35 /* HEADERIZER HFILE: compilers/imcc/symreg.h */
  36
  37 /* HEADERIZER BEGIN: static */
  38 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
  39
  40 PARROT_WARN_UNUSED_RESULT
  41 PARROT_CAN_RETURN_NULL
  42 static SymReg * _get_sym_typed(
  43     ARGIN(const SymHash *hsh),
  44     ARGIN(const char *name),
  45     int t)
  46         __attribute__nonnull__(1)
  47         __attribute__nonnull__(2);
  48
  49 PARROT_WARN_UNUSED_RESULT
  50 PARROT_CANNOT_RETURN_NULL
  51 PARROT_MALLOC
  52 static char * _mk_fullname(
  53     ARGIN_NULLOK(const Namespace *ns),
  54     ARGIN(const char *name))
  55         __attribute__nonnull__(2);
  56
  57 PARROT_WARN_UNUSED_RESULT
  58 PARROT_CANNOT_RETURN_NULL
  59 static SymReg * _mk_symreg(
  60     ARGMOD(SymHash *hsh),
  61     ARGIN(const char *name),
  62     int t)
  63         __attribute__nonnull__(1)
  64         __attribute__nonnull__(2)
  65         FUNC_MODIFIES(*hsh);
  66
  67 PARROT_WARN_UNUSED_RESULT
  68 PARROT_CANNOT_RETURN_NULL
  69 PARROT_MALLOC
  70 static char * add_ns(PARROT_INTERP, ARGIN(const char *name))
  71         __attribute__nonnull__(1)
  72         __attribute__nonnull__(2);
  73
  74 PARROT_CANNOT_RETURN_NULL
  75 PARROT_WARN_UNUSED_RESULT
  76 static SymReg * mk_pmc_const_2(PARROT_INTERP,
  77     ARGMOD(IMC_Unit *unit),
  78     ARGIN(SymReg *left),
  79     ARGMOD(SymReg *rhs))
  80         __attribute__nonnull__(1)
  81         __attribute__nonnull__(2)
  82         __attribute__nonnull__(3)
  83         __attribute__nonnull__(4)
  84         FUNC_MODIFIES(*unit)
  85         FUNC_MODIFIES(*rhs);
  86
  87 static void resize_symhash(ARGMOD(SymHash *hsh))
  88         __attribute__nonnull__(1)
  89         FUNC_MODIFIES(*hsh);
  90
  91 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
  92 /* HEADERIZER END: static */
  93
  94 /*
  95
  96 =item C<void push_namespace>
  97
  98 Begins a new namespace in PASM/PIR, named after the given C<name>.
  99
 100 =cut
 101
 102 */
 103
 104 void
 105 push_namespace(SHIM_INTERP, ARGIN(const char *name))
 106 {
 107     Namespace * const ns = mem_allocate_zeroed_typed(Namespace);
 108
 109     ns->parent = _namespace;
 110     ns->name   = str_dup(name);
 111     _namespace = ns;
 112 }
 113
 114
 115 /*
 116
 117 =item C<void pop_namespace>
 118
 119 Ends the current namespace, popping back to the previous.  If the namespace
 120 stack is empty, throws a syntax error.
 121
 122 =cut
 123
 124 */
 125
 126 void
 127 pop_namespace(PARROT_INTERP, ARGIN(const char *name))
 128 {
 129     Namespace * const ns = _namespace;
 130
 131     if (!ns)
 132         IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR, "pop() on empty namespace stack\n");
 133
 134     if (name && !STREQ(name, ns->name))
 135         IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR, "tried to pop namespace(%s), "
 136                 "but top of stack is namespace(%s)\n", name, ns->name);
 137
 138     while (ns->idents) {
 139         Identifier * const ident = ns->idents;
 140         ns->idents               = ident->next;
 141         mem_sys_free(ident);
 142     }
 143
 144     _namespace = ns->parent;
 145     mem_sys_free(ns);
 146 }
 147
 148
 149 /*
 150
 151 =item C<static SymReg * _get_sym_typed>
 152
 153 Gets a symbol from the hash, with the given C<name> of the specific type C<t>.
 154
 155 =cut
 156
 157 */
 158
 159 PARROT_WARN_UNUSED_RESULT
 160 PARROT_CAN_RETURN_NULL
 161 static SymReg *
 162 _get_sym_typed(ARGIN(const SymHash *hsh), ARGIN(const char *name), int t)
 163 {
 164     SymReg            *p;
 165     const unsigned int i = hash_str(name) % hsh->size;
 166
 167     for (p = hsh->data[i]; p; p = p->next) {
 168         if ((t == p->set) && STREQ(name, p->name))
 169             return p;
 170     }
 171
 172     return NULL;
 173 }
 174
 175
 176 /* symbolic registers */
 177
 178 /*
 179
 180 =item C<static SymReg * _mk_symreg>
 181
 182 Makes a new SymReg in the given SymHash from a varname and type.
 183
 184 =cut
 185
 186 */
 187
 188 PARROT_WARN_UNUSED_RESULT
 189 PARROT_CANNOT_RETURN_NULL
 190 static SymReg *
 191 _mk_symreg(ARGMOD(SymHash *hsh), ARGIN(const char *name), int t)
 192 {
 193     SymReg * r = _get_sym_typed(hsh, name, t);
 194
 195     if (!r) {
 196         r             = mem_allocate_zeroed_typed(SymReg);
 197         r->set        = t;
 198         r->type       = VTREG;
 199         r->name       = str_dup(name);
 200         r->color      = -1;
 201         r->want_regno = -1;
 202
 203         _store_symreg(hsh, r);
 204     }
 205
 206     return r;
 207 }
 208
 209
 210 /*
 211
 212 =item C<SymReg * mk_symreg>
 213
 214 Makes a new SymReg in the current unit, given a varname and type.
 215
 216 =cut
 217
 218 */
 219
 220 PARROT_WARN_UNUSED_RESULT
 221 PARROT_CANNOT_RETURN_NULL
 222 SymReg *
 223 mk_symreg(PARROT_INTERP, ARGIN(const char *name), int t)
 224 {
 225     IMC_Unit * const unit = IMCC_INFO(interp)->last_unit;
 226     return _mk_symreg(&unit->hash, name, t);
 227 }
 228
 229
 230 /*
 231
 232 =item C<char * symreg_to_str>
 233
 234 Dumps a SymReg to a printable format.
 235
 236 =cut
 237
 238 */
 239
 240 PARROT_MALLOC
 241 PARROT_WARN_UNUSED_RESULT
 242 PARROT_CANNOT_RETURN_NULL
 243 char *
 244 symreg_to_str(ARGIN(const SymReg *s))
 245 {
 246     /* NOTE: the below magic number encompasses all the quoted strings which
 247      * may be included in the sprintf output (for now) */
 248     char * const buf = (char *)mem_sys_allocate(250 + strlen(s->name));
 249     const int    t   = s->type;
 250
 251     sprintf(buf, "symbol [%s]  set [%c]  color [" INTVAL_FMT "]  type [",
 252                  s->name, s->set, s->color);
 253
 254     if (t & VTCONST)      { strcat(buf, "VTCONST ");       }
 255     if (t & VTREG)        { strcat(buf, "VTREG ");         }
 256     if (t & VTIDENTIFIER) { strcat(buf, "VTIDENTIFIER ");  }
 257     if (t & VTADDRESS)    { strcat(buf, "VTADDRESS ");     }
 258     if (t & VTREGKEY)     { strcat(buf, "VTREGKEY ");      }
 259     if (t & VTPASM)       { strcat(buf, "VTPASM ");        }
 260     if (t & VT_CONSTP)    { strcat(buf, "VT_CONSTP ");     }
 261     if (t & VT_PCC_SUB)   { strcat(buf, "VT_PCC_SUB ");    }
 262     if (t & VT_FLAT)      { strcat(buf, "VT_FLAT ");       }
 263     if (t & VT_OPTIONAL)  { strcat(buf, "VT_OPTIONAL ");   }
 264     if (t & VT_NAMED)     { strcat(buf, "VT_NAMED ");      }
 265
 266     strcat(buf, "]");
 267
 268     return buf;
 269 }
 270
 271
 272 /*
 273
 274 =item C<SymReg * mk_temp_reg>
 275
 276 Makes a new unique and temporary SymReg of the specified type C<t>.
 277
 278 =cut
 279
 280 */
 281
 282 PARROT_WARN_UNUSED_RESULT
 283 PARROT_CANNOT_RETURN_NULL
 284 SymReg *
 285 mk_temp_reg(PARROT_INTERP, int t)
 286 {
 287     char       buf[30];
 288     static int temp;
 289
 290     snprintf(buf, sizeof (buf), "__imcc_temp_%d", ++temp);
 291     return mk_symreg(interp, buf, t);
 292 }
 293
 294
 295 /*
 296
 297 =item C<SymReg * mk_pcc_sub>
 298
 299 Makes a SymReg representing a PCC sub of the given C<name> with the specified
 300 type.
 301
 302 =cut
 303
 304 */
 305
 306 PARROT_WARN_UNUSED_RESULT
 307 PARROT_CANNOT_RETURN_NULL
 308 SymReg *
 309 mk_pcc_sub(PARROT_INTERP, ARGIN(const char *name), int proto)
 310 {
 311     IMC_Unit * const unit = IMCC_INFO(interp)->last_unit;
 312     SymReg   * const r    = _mk_symreg(&unit->hash, name, proto);
 313
 314     r->type    = VT_PCC_SUB;
 315     r->pcc_sub = mem_allocate_zeroed_typed(pcc_sub_t);
 316
 317     return r;
 318 }
 319
 320
 321 /*
 322
 323 =item C<void add_namespace>
 324
 325 Add the current namespace to a sub declaration.
 326
 327 =cut
 328
 329 */
 330
 331 void
 332 add_namespace(PARROT_INTERP, ARGMOD(IMC_Unit *unit))
 333 {
 334     SymReg * const ns = IMCC_INFO(interp)->cur_namespace;
 335
 336     if (!ns)
 337         return;
 338
 339     if (unit->_namespace)
 340         return;
 341
 342     if (unit->prev && unit->prev->_namespace == ns)
 343         unit->_namespace = ns;
 344     else {
 345         SymReg * const g = dup_sym(ns);
 346         SymReg * const r = _get_sym(&IMCC_INFO(interp)->ghash, g->name);
 347
 348         unit->_namespace = g;
 349         g->reg           = ns;
 350         g->type          = VT_CONSTP;
 351
 352         if (!r || r->type != VT_CONSTP)
 353             _store_symreg(&IMCC_INFO(interp)->ghash, g);
 354     }
 355 }
 356
 357
 358 /*
 359
 360 =item C<void add_pcc_arg>
 361
 362 Adds a register or constant to the function arg list.
 363
 364 =cut
 365
 366 */
 367
 368 void
 369 add_pcc_arg(ARGMOD(SymReg *r), ARGMOD(SymReg *arg))
 370 {
 371     pcc_sub_t * const sub = r->pcc_sub;
 372     const int         n   = sub->nargs;
 373
 374     mem_realloc_n_typed(sub->args,      n + 1, SymReg *);
 375     mem_realloc_n_typed(sub->arg_flags, n + 1, int);
 376
 377     sub->args[n]      = arg;
 378     sub->arg_flags[n] = arg->type;
 379
 380     arg->type &= ~(VT_FLAT|VT_OPTIONAL|VT_OPT_FLAG|VT_NAMED);
 381
 382     sub->nargs++;
 383 }
 384
 385
 386 /*
 387
 388 =item C<void add_pcc_result>
 389
 390 Adds a register or constant to the function's return list.
 391
 392 =cut
 393
 394 */
 395
 396 void
 397 add_pcc_result(ARGMOD(SymReg *r), ARGMOD(SymReg *arg))
 398 {
 399     pcc_sub_t * const sub = r->pcc_sub;
 400     const int         n   = sub->nret;
 401
 402     mem_realloc_n_typed(sub->ret,       n + 1, SymReg *);
 403     mem_realloc_n_typed(sub->ret_flags, n + 1, int);
 404
 405     /* we can't keep the flags in the SymReg as the SymReg
 406      * maybe used with different flags for different calls */
 407     sub->ret[n]       = arg;
 408     sub->ret_flags[n] = arg->type;
 409
 410     arg->type &= ~(VT_FLAT|VT_OPTIONAL|VT_OPT_FLAG|VT_NAMED);
 411
 412     sub->nret++;
 413 }
 414
 415
 416 /*
 417
 418 =item C<void add_pcc_multi>
 419
 420 Adds a :multi signature to the sub.
 421
 422 =cut
 423
 424 */
 425
 426 void
 427 add_pcc_multi(ARGMOD(SymReg *r), ARGIN_NULLOK(SymReg *arg))
 428 {
 429     pcc_sub_t * const sub = r->pcc_sub;
 430     const int n           = sub->nmulti;
 431
 432     mem_realloc_n_typed(sub->multi, n + 1, SymReg *);
 433     sub->multi[n] = arg;
 434     sub->nmulti++;
 435 }
 436
 437
 438 /*
 439
 440 =item C<void add_pcc_sub>
 441
 442 Sets the current sub in the given SymReg to the second SymReg.
 443
 444 =cut
 445
 446 */
 447
 448 void
 449 add_pcc_sub(ARGMOD(SymReg *r), ARGIN(SymReg *arg))
 450 {
 451     r->pcc_sub->sub = arg;
 452 }
 453
 454
 455 /*
 456
 457 =item C<void add_pcc_cc>
 458
 459 Adds a continuation (?) to the current sub.
 460
 461 =cut
 462
 463 */
 464
 465 void
 466 add_pcc_cc(ARGMOD(SymReg *r), ARGIN(SymReg *arg))
 467 {
 468     r->pcc_sub->cc = arg;
 469 }
 470
 471
 472 /*
 473
 474 =item C<SymReg * mk_pasm_reg>
 475
 476 Makes a SymReg representing a PASM register.
 477
 478 =cut
 479
 480 */
 481
 482 PARROT_WARN_UNUSED_RESULT
 483 PARROT_CANNOT_RETURN_NULL
 484 SymReg *
 485 mk_pasm_reg(PARROT_INTERP, ARGIN(const char *name))
 486 {
 487     SymReg *r    = _get_sym(&IMCC_INFO(interp)->cur_unit->hash, name);
 488
 489     if (!r) {
 490         r        = mk_symreg(interp, name, *name);
 491         r->type  = VTPASM;
 492         r->color = atoi(name + 1);
 493
 494         if (r->color < 0)
 495             IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
 496                 "register number out of range '%s'\n", name);
 497     }
 498
 499     return r;
 500 }
 501
 502
 503 /*
 504
 505 =item C<static char * _mk_fullname>
 506
 507 Combines the namespace and name together, separated by a C<::>.  If there's no
 508 namespace, the name is returned on its own.
 509
 510 The returned string must be free()d.
 511
 512 =cut
 513
 514 */
 515
 516 PARROT_WARN_UNUSED_RESULT
 517 PARROT_CANNOT_RETURN_NULL
 518 PARROT_MALLOC
 519 static char *
 520 _mk_fullname(ARGIN_NULLOK(const Namespace *ns), ARGIN(const char *name))
 521 {
 522     if (ns) {
 523         const size_t len = strlen(name) + strlen(ns->name) + 3;
 524         char *result = (char *) mem_sys_allocate(len);
 525         snprintf(result, len, "%s::%s", ns->name, name);
 526         return result;
 527     }
 528
 529     return str_dup(name);
 530 }
 531
 532
 533 /*
 534
 535 =item C<SymReg * mk_ident>
 536
 537 Makes a new identifier.
 538
 539 =cut
 540
 541 */
 542
 543 PARROT_CANNOT_RETURN_NULL
 544 PARROT_IGNORABLE_RESULT
 545 SymReg *
 546 mk_ident(PARROT_INTERP, ARGIN(const char *name), int t)
 547 {
 548     char   * const fullname = _mk_fullname(_namespace, name);
 549     SymReg        *r        = mk_symreg(interp, fullname, t);
 550
 551     r->type = VTIDENTIFIER;
 552
 553     if (_namespace) {
 554         Identifier * const ident = mem_allocate_zeroed_typed(Identifier);
 555
 556         ident->name        = fullname;
 557         ident->next        = _namespace->idents;
 558         _namespace->idents = ident;
 559     }
 560     else
 561         mem_sys_free(fullname);
 562
 563     if (t == 'P') {
 564         r->pmc_type                     = IMCC_INFO(interp)->cur_pmc_type;
 565         IMCC_INFO(interp)->cur_pmc_type = 0;
 566     }
 567
 568     return r;
 569 }
 570
 571
 572 /*
 573
 574 =item C<SymReg* mk_ident_ur>
 575
 576 Creates and returns a SymReg representing a unique (non-volatile) register.
 577
 578 =cut
 579
 580 */
 581
 582 PARROT_CANNOT_RETURN_NULL
 583 PARROT_IGNORABLE_RESULT
 584 SymReg*
 585 mk_ident_ur(PARROT_INTERP, ARGIN(const char *name), int t)
 586 {
 587     SymReg * const r = mk_ident(interp, name, t);
 588     r->usage        |= U_NON_VOLATILE;
 589
 590     return r;
 591 }
 592
 593
 594 /*
 595
 596 =item C<static SymReg * mk_pmc_const_2>
 597
 598 Makes a constant PMC and inserts instructions to access it.
 599
 600 =cut
 601
 602 */
 603
 604 PARROT_CANNOT_RETURN_NULL
 605 PARROT_WARN_UNUSED_RESULT
 606 static SymReg *
 607 mk_pmc_const_2(PARROT_INTERP, ARGMOD(IMC_Unit *unit), ARGIN(SymReg *left),
 608         ARGMOD(SymReg *rhs))
 609 {
 610     /* XXX This always returns NULL.  Probably shouldn't return anything then. */
 611     SymReg *r[2];
 612     char   *name;
 613     int     len;
 614
 615     if (IMCC_INFO(interp)->state->pasm_file)
 616         IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
 617             "Ident as PMC constant %s\n", left->name);
 618
 619     r[0] = left;
 620
 621     /* strip delimiters */
 622     name          = str_dup(rhs->name + 1);
 623     len           = strlen(name);
 624     name[len - 1] = '\0';
 625
 626     mem_sys_free(rhs->name);
 627
 628     rhs->name     = name;
 629     rhs->set      = 'P';
 630     rhs->pmc_type = left->pmc_type;
 631
 632     switch (rhs->pmc_type) {
 633         case enum_class_Sub:
 634         case enum_class_Coroutine:
 635             r[1]       = rhs;
 636             rhs->usage = U_FIXUP;
 637             INS(interp, unit, "set_p_pc", "", r, 2, 0, 1);
 638             return NULL;
 639         default:
 640             break;
 641     }
 642
 643     r[1] = rhs;
 644     INS(interp, unit, "set_p_pc", "", r, 2, 0, 1);
 645
 646     return NULL;
 647 }
 648
 649
 650 /*
 651
 652 =item C<SymReg * mk_const_ident>
 653
 654 Makes a new identifier constant with value val.
 655
 656 =cut
 657
 658 */
 659
 660 PARROT_CANNOT_RETURN_NULL
 661 PARROT_IGNORABLE_RESULT
 662 SymReg *
 663 mk_const_ident(PARROT_INTERP, ARGIN(const char *name), int t,
 664         ARGMOD(SymReg *val), int global)
 665 {
 666     SymReg *r;
 667
 668     /*
 669      * Forbid assigning a string to anything other than a string
 670      * or PMC constant
 671      */
 672     if (t == 'N' || t == 'I') {
 673         if (val->set == 'S')
 674             IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR, "bad const initialisation");
 675
 676         /* Cast value to const type */
 677         val->set = t;
 678     }
 679
 680     if (global) {
 681         if (t == 'P')
 682             IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
 683                     "global PMC constant not allowed");
 684
 685         r = _mk_symreg(&IMCC_INFO(interp)->ghash, name, t);
 686     }
 687     else {
 688         r = mk_ident(interp, name, t);
 689
 690         if (t == 'P')
 691             return mk_pmc_const_2(interp, IMCC_INFO(interp)->cur_unit, r, val);
 692     }
 693
 694     r->type = VT_CONSTP;
 695     r->reg  = val;
 696
 697     return r;
 698 }
 699
 700
 701 /*
 702
 703 =item C<SymReg * _mk_const>
 704
 705 Makes a new constant (internal use only).
 706
 707 =cut
 708
 709 */
 710
 711 PARROT_WARN_UNUSED_RESULT
 712 PARROT_CANNOT_RETURN_NULL
 713 SymReg *
 714 _mk_const(ARGMOD(SymHash *hsh), ARGIN(const char *name), int t)
 715 {
 716     SymReg * const r = _mk_symreg(hsh, name, t);
 717     r->type          = VTCONST;
 718
 719     if (t == 'U') {
 720         /* charset:"string" */
 721         r->set   = 'S';
 722         r->type |= VT_ENCODED;
 723     }
 724
 725     r->use_count++;
 726
 727     return r;
 728 }
 729
 730
 731 /*
 732
 733 =item C<SymReg * mk_const>
 734
 735 Makes a new constant (and populates the cache of global symbols).
 736
 737 =cut
 738
 739 */
 740
 741 PARROT_WARN_UNUSED_RESULT
 742 PARROT_CANNOT_RETURN_NULL
 743 SymReg *
 744 mk_const(PARROT_INTERP, ARGIN(const char *name), int t)
 745 {
 746     SymHash * const h = &IMCC_INFO(interp)->ghash;
 747
 748     if (!h->data)
 749         create_symhash(h);
 750
 751     return _mk_const(h, name, t);
 752 }
 753
 754
 755 /*
 756
 757 =item C<static char * add_ns>
 758
 759 Adds a namespace to the current sub.
 760
 761 =cut
 762
 763 */
 764
 765 PARROT_WARN_UNUSED_RESULT
 766 PARROT_CANNOT_RETURN_NULL
 767 PARROT_MALLOC
 768 static char *
 769 add_ns(PARROT_INTERP, ARGIN(const char *name))
 770 {
 771     size_t len, l;
 772     char *ns_name, *p;
 773
 774     if (!IMCC_INFO(interp)->cur_namespace
 775     || (l = strlen(IMCC_INFO(interp)->cur_namespace->name)) <= 2)
 776         return str_dup(name);
 777
 778     /* TODO keyed syntax */
 779     len     = strlen(name) + l  + 4;
 780     ns_name = (char*)mem_sys_allocate(len);
 781
 782     strcpy(ns_name, IMCC_INFO(interp)->cur_namespace->name);
 783     *ns_name       = '_';
 784     ns_name[l - 1] = '\0';
 785     strcat(ns_name, "@@@");
 786     strcat(ns_name, name);
 787
 788     p = strstr(ns_name, "\";\"");   /* Foo";"Bar  -> Foo@@@Bar */
 789
 790     while (p) {
 791         p[0] = '@';
 792         p[1] = '@';
 793         p[2] = '@';
 794         p    = strstr(ns_name, "\";\")");
 795     }
 796
 797     return ns_name;
 798 }
 799
 800
 801 /*
 802
 803 =item C<SymReg * _mk_address>
 804
 805 Makes a new address (internal use only).
 806
 807 =cut
 808
 809 */
 810
 811 PARROT_WARN_UNUSED_RESULT
 812 PARROT_CANNOT_RETURN_NULL
 813 SymReg *
 814 _mk_address(PARROT_INTERP, ARGMOD(SymHash *hsh), ARGIN(const char *name), int uniq)
 815 {
 816     SymReg *r;
 817
 818     if (uniq == U_add_all) {
 819         r       = mem_allocate_zeroed_typed(SymReg);
 820         r->type = VTADDRESS;
 821         r->name = str_dup(name);
 822         _store_symreg(hsh, r);
 823     }
 824     else {
 825         if (uniq == U_add_uniq_sub)
 826             name = add_ns(interp, name);
 827
 828         r = _get_sym(hsh, name);
 829
 830         /* we use this for labels/subs */
 831         if (uniq && r && r->type == VTADDRESS && r->lhs_use_count) {
 832             if (uniq == U_add_uniq_label)
 833                 IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
 834                     "Label '%s' already defined\n", name);
 835             else if (uniq == U_add_uniq_sub)
 836                 IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
 837                         "Subroutine '%s' already defined\n", name);
 838         }
 839
 840         r       = _mk_symreg(hsh, name, 0);
 841         r->type = VTADDRESS;
 842
 843         if (uniq)
 844             r->lhs_use_count++;
 845     }
 846
 847     return r;
 848 }
 849
 850
 851 /*
 852
 853 =item C<SymReg * mk_sub_label>
 854
 855 Makes and stores a new address label for a sub.  The label gets a fixup entry.
 856
 857 =cut
 858
 859 */
 860
 861 PARROT_WARN_UNUSED_RESULT
 862 PARROT_CANNOT_RETURN_NULL
 863 SymReg *
 864 mk_sub_label(PARROT_INTERP, ARGIN(const char *name))
 865 {
 866     SymReg * const s = _mk_address(interp, &IMCC_INFO(interp)->ghash,
 867             name, U_add_uniq_sub);
 868
 869     s->usage |= U_FIXUP;
 870
 871     return s;
 872 }
 873
 874
 875 /*
 876
 877 =item C<SymReg * mk_sub_address>
 878
 879 Makes a symbol for a label.  The symbol gets a fixup entry.
 880
 881 =cut
 882
 883 */
 884
 885 PARROT_WARN_UNUSED_RESULT
 886 PARROT_CANNOT_RETURN_NULL
 887 SymReg *
 888 mk_sub_address(PARROT_INTERP, ARGIN(const char *name))
 889 {
 890     SymReg * const s = _mk_address(interp, &IMCC_INFO(interp)->ghash,
 891             name, U_add_all);
 892
 893     s->usage |= U_FIXUP;
 894
 895     return s;
 896 }
 897
 898
 899 /*
 900
 901 =item C<SymReg * mk_local_label>
 902
 903 Makes a local symbol, giving it I<no> fixup entry.
 904
 905 =cut
 906
 907 */
 908
 909 PARROT_WARN_UNUSED_RESULT
 910 PARROT_CANNOT_RETURN_NULL
 911 SymReg *
 912 mk_local_label(PARROT_INTERP, ARGIN(const char *name))
 913 {
 914     IMC_Unit * const unit = IMCC_INFO(interp)->last_unit;
 915     return _mk_address(interp, &unit->hash, name, U_add_uniq_label);
 916 }
 917
 918
 919 /*
 920
 921 =item C<SymReg * mk_label_address>
 922
 923 Makes a new label address.
 924
 925 =cut
 926
 927 */
 928
 929 PARROT_WARN_UNUSED_RESULT
 930 PARROT_CANNOT_RETURN_NULL
 931 SymReg *
 932 mk_label_address(PARROT_INTERP, ARGIN(const char *name))
 933 {
 934     IMC_Unit * const unit = IMCC_INFO(interp)->last_unit;
 935     return _mk_address(interp, &unit->hash, name, U_add_once);
 936 }
 937
 938
 939 /*
 940
 941 =item C<SymReg * dup_sym>
 942
 943 Links keys to a keys structure = SymReg
 944
 945 we might have
 946
 947 what         op      type        pbc.c:build_key()
 948 --------------------------------------------------
 949  int const   _kic    VTCONST     no
 950  int reg     _ki     VTREG       no
 951  str const   _kc     VTCONST     yes
 952  str reg     _kc     VTREG       yes
 953
 954  "key" ';' "key" _kc           -> (list of above)   yes
 955  "key" ';' $I0   _kc  VTREGKEY -> (list of above)   yes
 956
 957  The information about which reg should be passed to build_key() is
 958  in the instruction.
 959
 960  A key containing a variable has a special flag VTREGKEY
 961  because this key must be considered for life analysis for
 962  all the chain members, that are variables.
 963
 964  An instruction with a keychain looks like this
 965
 966  e.h. set I0, P["abc";0;I1]
 967
 968  ins->r[2]  = keychain  'K'
 969  keychain->nextkey = SymReg(VTCONST) "abc"
 970              ->nextkey = SymReg(VTCONST) 0
 971                 ->nextkey = SymReg(VTREG), ...->reg = VTVAR I1
 972                    ->nextkey = 0
 973
 974  We can't use the consts or keys in the chain directly,
 975  because a different usage would destroy the ->nextkey pointers
 976  so these are all copies.
 977  XXX and currently not freed
 978
 979 =cut
 980
 981 */
 982
 983 PARROT_MALLOC
 984 PARROT_CANNOT_RETURN_NULL
 985 SymReg *
 986 dup_sym(ARGIN(const SymReg *r))
 987 {
 988     SymReg * const new_sym = mem_allocate_zeroed_typed(SymReg);
 989     STRUCT_COPY(new_sym, r);
 990     new_sym->name = str_dup(r->name);
 991
 992     if (r->nextkey)
 993         new_sym->nextkey = dup_sym(r->nextkey);
 994
 995     return new_sym;
 996 }
 997
 998
 999 /*
1000
1001 =item C<SymReg * link_keys>
1002
1003 Links keys together in a keychain.
1004
1005 =cut
1006
1007 */
1008
1009 PARROT_MALLOC
1010 PARROT_CANNOT_RETURN_NULL
1011 SymReg *
1012 link_keys(PARROT_INTERP, int nargs, ARGMOD(SymReg **keys), int force)
1013 {
1014     char   *key_str;
1015     SymReg *key;
1016     SymReg *keychain;
1017     int     i;
1018     int     any_slice = 0;
1019     size_t  len       = 0;
1020
1021     /* namespace keys are global consts - no cur_unit */
1022     SymHash * const h = IMCC_INFO(interp)->cur_unit
1023                       ? &IMCC_INFO(interp)->cur_unit->hash
1024                       : &IMCC_INFO(interp)->ghash;
1025
1026     if (nargs == 0)
1027         IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR, "link_keys: huh? no keys\n");
1028
1029     /* short-circuit simple key unless we've been told not to */
1030     if (nargs == 1 && !force && !(keys[0]->type & VT_SLICE_BITS))
1031         return keys[0];
1032
1033     /* calc len of key_str
1034      * also check if this is a slice - the first key might not
1035      * have the slice flag set */
1036     for (i = 0; i < nargs; i++) {
1037         len += 1 + strlen(keys[i]->name);
1038         if (keys[i]->type & VT_SLICE_BITS)
1039             any_slice = 1;
1040     }
1041
1042     if (any_slice && !(keys[0]->type & VT_SLICE_BITS))
1043         keys[0]->type |= (VT_START_SLICE|VT_END_SLICE);
1044
1045     key_str  = (char *)mem_sys_allocate(len);
1046     *key_str = '\0';
1047
1048     /* first look, if we already have this exact key chain */
1049     for (i = 0; i < nargs; i++) {
1050         strcat(key_str, keys[i]->name);
1051         /* TODO insert : to compare slices */
1052         if (i < nargs - 1)
1053             strcat(key_str, ";");
1054     }
1055
1056     if (!any_slice && ((keychain = _get_sym(h, key_str)) != NULL)) {
1057         mem_sys_free(key_str);
1058         return keychain;
1059     }
1060
1061     /* no, need a new one */
1062     keychain       = mem_allocate_zeroed_typed(SymReg);
1063     keychain->type = VTCONST;
1064
1065     ++keychain->use_count;
1066
1067     key = keychain;
1068
1069     for (i = 0; i < nargs; i++) {
1070         /* if any component is a variable, we need to track it in
1071          * life analysis */
1072         if (REG_NEEDS_ALLOC(keys[i]))
1073             keychain->type |= VTREGKEY;
1074
1075         key->nextkey = dup_sym(keys[i]);
1076         key          = key->nextkey;
1077
1078         /* for registers, point ->reg to the original, needed by
1079          * life analyses & coloring */
1080         if (REG_NEEDS_ALLOC(keys[i]))
1081             key->reg = keys[i];
1082     }
1083
1084     keychain->name  = key_str;
1085     keychain->set   = 'K';
1086     keychain->color = -1;
1087
1088     _store_symreg(h, keychain);
1089
1090     return keychain;
1091 }
1092
1093
1094 /*
1095
1096 =item C<void free_sym>
1097
1098 Frees all memory of the specified SymReg.  If it has a pcc_sub_t entry, frees
1099 all memory of that structure as well.
1100
1101 =cut
1102
1103 */
1104
1105 void
1106 free_sym(ARGMOD(SymReg *r))
1107 {
1108     pcc_sub_t * const sub = r->pcc_sub;
1109
1110     if (sub) {
1111         mem_sys_free(sub->multi);
1112         mem_sys_free(sub->args);
1113         mem_sys_free(sub->arg_flags);
1114         mem_sys_free(sub->ret);
1115         mem_sys_free(sub->ret_flags);
1116         mem_sys_free(sub);
1117     }
1118
1119     if (r->set == 'K') {
1120         SymReg *key     = r->nextkey;
1121         while (key) {
1122             SymReg *nextkey = key->nextkey;
1123             free_sym(key);
1124             key = nextkey;
1125         }
1126     }
1127
1128     mem_sys_free(r->name);
1129     mem_sys_free(r);
1130 }
1131
1132 /*
1133  * This functions manipulate the hash of symbols.
1134  * XXX: Migrate to use Symbol and SymbolTable
1135  *
1136  */
1137
1138 /*
1139
1140 =item C<void create_symhash>
1141
1142 Creates a symbol hash table with space for 16 entries.
1143
1144 =cut
1145
1146 */
1147
1148 void
1149 create_symhash(ARGOUT(SymHash *hash))
1150 {
1151     hash->data    = mem_allocate_n_zeroed_typed(16, SymReg *);
1152     hash->size    = 16;
1153     hash->entries = 0;
1154 }
1155
1156
1157 /*
1158
1159 =item C<static void resize_symhash>
1160
1161 Resizes a symbol hash table.
1162
1163 =cut
1164
1165 */
1166
1167 static void
1168 resize_symhash(ARGMOD(SymHash *hsh))
1169 {
1170     const int new_size = hsh->size << 1; /* new size is twice as large */
1171     int       n_next   = 16;
1172     SymReg  **next_r   = mem_allocate_n_zeroed_typed(n_next, SymReg *);
1173     SymHash   nh;                        /* new symbol table */
1174     int       i;
1175
1176     nh.data = mem_allocate_n_zeroed_typed(new_size, SymReg *);
1177
1178     for (i = 0; i < hsh->size; i++) {
1179         SymReg *r, *next;
1180         int     k;
1181         int     j = 0;
1182
1183         for (r = hsh->data[i]; r; r = next) {
1184             next = r->next;
1185
1186             /* remember all the chained next pointers and clear r->next */
1187             if (j >= n_next) {
1188                 n_next <<= 1;
1189                 mem_realloc_n_typed(next_r, n_next, SymReg *);
1190             }
1191
1192             r->next     = NULL;
1193             next_r[j++] = r;
1194         }
1195
1196         for (k = 0; k < j; ++k) {
1197             int new_i;
1198             r              = next_r[k];
1199             /* recompute hash for this symbol: */
1200             new_i          = hash_str(r->name) % new_size;
1201             r->next        = nh.data[new_i];
1202             nh.data[new_i] = r;
1203         }
1204     }
1205
1206     /* free memory of old hash table */
1207     mem_sys_free(hsh->data);
1208     mem_sys_free(next_r);
1209
1210     /* let the hashtable's data pointers point to the new data */
1211     hsh->data = nh.data;
1212     hsh->size = new_size;
1213 }
1214
1215
1216 /*
1217
1218 =item C<void _store_symreg>
1219
1220 Stores a symbol in the hash (internal use only).
1221
1222 =cut
1223
1224 */
1225
1226 void
1227 _store_symreg(ARGMOD(SymHash *hsh), ARGMOD(SymReg *r))
1228 {
1229     const int i = hash_str(r->name) % hsh->size;
1230 #if IMC_TRACE_HIGH
1231     printf("    store [%s]\n", r->name);
1232 #endif
1233     r->next      = hsh->data[i];
1234     hsh->data[i] = r;
1235
1236     hsh->entries++;
1237
1238     if (hsh->entries >= hsh->size)
1239         resize_symhash(hsh);
1240 }
1241
1242
1243 /*
1244
1245 =item C<void store_symreg>
1246
1247 Stores a symbol in the hash.
1248
1249 =cut
1250
1251 */
1252
1253 void
1254 store_symreg(PARROT_INTERP, ARGMOD(SymReg *r))
1255 {
1256     _store_symreg(&IMCC_INFO(interp)->cur_unit->hash, r);
1257 }
1258
1259
1260 /*
1261
1262 =item C<SymReg * _get_sym>
1263
1264 Fetches a symbol from the hash (internal use only).
1265
1266 =cut
1267
1268 */
1269
1270 PARROT_CAN_RETURN_NULL
1271 PARROT_WARN_UNUSED_RESULT
1272 SymReg *
1273 _get_sym(ARGIN(const SymHash *hsh), ARGIN(const char *name))
1274 {
1275     SymReg   *p;
1276     const unsigned int i = hash_str(name) % hsh->size;
1277
1278     for (p = hsh->data[i]; p; p = p->next) {
1279 #if IMC_TRACE_HIGH
1280         printf("   [%s]\n", p->name);
1281 #endif
1282         if (STREQ(name, p->name))
1283             return p;
1284     }
1285
1286     return NULL;
1287 }
1288
1289 /*
1290
1291 =item C<SymReg * get_sym>
1292
1293 Gets a symbol from the current unit's symbol table.
1294
1295 =cut
1296
1297 */
1298
1299 PARROT_CAN_RETURN_NULL
1300 PARROT_WARN_UNUSED_RESULT
1301 SymReg *
1302 get_sym(PARROT_INTERP, ARGIN(const char *name))
1303 {
1304     return _get_sym(&IMCC_INFO(interp)->cur_unit->hash, name);
1305 }
1306
1307
1308 /*
1309
1310 =item C<SymReg * _find_sym>
1311
1312 Find a symbol hash or ghash (internal use only);
1313
1314 =cut
1315
1316 */
1317
1318 PARROT_CAN_RETURN_NULL
1319 PARROT_WARN_UNUSED_RESULT
1320 SymReg *
1321 _find_sym(PARROT_INTERP, ARGIN_NULLOK(const Namespace *nspace),
1322         ARGIN(const SymHash *hsh), ARGIN(const char *name))
1323 {
1324     const Namespace *ns;
1325     SymReg          *p;
1326
1327     for (ns = nspace; ns; ns = ns->parent) {
1328         char * const fullname = _mk_fullname(ns, name);
1329         p                     = _get_sym(hsh, fullname);
1330
1331         mem_sys_free(fullname);
1332
1333         if (p)
1334             return p;
1335     }
1336
1337     p = _get_sym(hsh, name);
1338
1339     if (p)
1340         return p;
1341
1342     p = _get_sym(&IMCC_INFO(interp)->ghash, name);
1343
1344     if (p)
1345         return p;
1346
1347     return NULL;
1348 }
1349
1350
1351 /*
1352
1353 =item C<SymReg * find_sym>
1354
1355 Finds a symbol hash or ghash in the current unit, if it exists.  Otherwise
1356 returns NULL.
1357
1358 =cut
1359
1360 */
1361
1362 PARROT_CAN_RETURN_NULL
1363 PARROT_WARN_UNUSED_RESULT
1364 SymReg *
1365 find_sym(PARROT_INTERP, ARGIN(const char *name))
1366 {
1367     if (IMCC_INFO(interp)->cur_unit)
1368         return _find_sym(interp, _namespace,
1369             &IMCC_INFO(interp)->cur_unit->hash, name);
1370
1371     return NULL;
1372 }
1373
1374
1375 /*
1376
1377 =item C<void clear_sym_hash>
1378
1379 Frees all memory of the symbols in the specified hash table.
1380
1381 =cut
1382
1383 */
1384
1385 void
1386 clear_sym_hash(ARGMOD(SymHash *hsh))
1387 {
1388     int i;
1389
1390     if (!hsh->data)
1391         return;
1392
1393     for (i = 0; i < hsh->size; i++) {
1394         SymReg *p;
1395         for (p = hsh->data[i]; p;) {
1396             SymReg * const next = p->next;
1397             free_sym(p);
1398             p = next;
1399         }
1400
1401         hsh->data[i] = NULL;
1402     }
1403
1404     mem_sys_free(hsh->data);
1405
1406     hsh->data    = NULL;
1407     hsh->entries = 0;
1408     hsh->size    = 0;
1409 }
1410
1411
1412 /*
1413
1414 =item C<void debug_dump_sym_hash>
1415
1416 Prints all identifiers in the specified hash table to stderr.
1417
1418 =cut
1419
1420 */
1421
1422 void
1423 debug_dump_sym_hash(ARGIN(const SymHash *hsh))
1424 {
1425     int i;
1426
1427     for (i = 0; i < hsh->size; i++) {
1428         const SymReg *p = hsh->data[i];
1429         while (p) {
1430             fprintf(stderr, "%s ", p->name);
1431             p = p->next;
1432         }
1433     }
1434 }
1435
1436
1437 /*
1438
1439 =item C<void clear_locals>
1440
1441 Deletes all local symbols and clears life info from the given IMC_Unit.
1442
1443 =cut
1444
1445 */
1446
1447 void
1448 clear_locals(ARGIN_NULLOK(IMC_Unit *unit))
1449 {
1450     SymHash * const hsh = &unit->hash;
1451     int i;
1452
1453     for (i = 0; i < hsh->size; i++) {
1454         SymReg *p;
1455         for (p = hsh->data[i]; p;) {
1456             SymReg * const next = p->next;
1457
1458             if (unit && p->life_info)
1459                 free_life_info(unit, p);
1460
1461             free_sym(p);
1462             p = next;
1463         }
1464
1465         hsh->data[i] = NULL;
1466     }
1467
1468     hsh->entries = 0;
1469 }
1470
1471
1472 /*
1473
1474 =item C<void clear_globals>
1475
1476 Clears global symbols.
1477
1478 =cut
1479
1480 */
1481
1482 void
1483 clear_globals(PARROT_INTERP)
1484 {
1485     SymHash * const hsh = &IMCC_INFO(interp)->ghash;
1486
1487     if (hsh->data)
1488         clear_sym_hash(hsh);
1489 }
1490
1491
1492 /* utility functions: */
1493
1494 /*
1495
1496 =item C<unsigned int hash_str>
1497
1498 Computes the hash value for the string argument.
1499
1500 =cut
1501
1502 */
1503
1504 PARROT_PURE_FUNCTION
1505 unsigned int
1506 hash_str(ARGIN(const char *str))
1507 {
1508     unsigned long  key = 0;
1509     const    char *s;
1510
1511     for (s = str; *s; s++)
1512         key = key * 65599 + *s;
1513
1514     return key;
1515 }
1516
1517
1518 /*
1519
1520 =back
1521
1522 =cut
1523
1524 */
1525
1526 /*
1527  * Local variables:
1528  *   c-file-style: "parrot"
1529  * End:
1530  * vim: expandtab shiftwidth=4:
1531  */