src/global.c

   1 /*
   2 Copyright (C) 2004-2009, Parrot Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 src/global.c
   8
   9 =head1 DESCRIPTION
  10
  11 Access to global PMCs
  12
  13 =head1 FUNCTIONS
  14
  15 =over 4
  16
  17 =cut
  18
  19 */
  20
  21 #include "parrot/parrot.h"
  22 #include "global.str"
  23 #include "pmc/pmc_sub.h"
  24 #include "pmc/pmc_callcontext.h"
  25
  26 /* HEADERIZER HFILE: include/parrot/global.h */
  27 /* HEADERIZER BEGIN: static */
  28 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
  29
  30 PARROT_WARN_UNUSED_RESULT
  31 PARROT_CAN_RETURN_NULL
  32 static PMC * get_namespace_pmc(PARROT_INTERP, ARGIN(PMC *sub_pmc))
  33         __attribute__nonnull__(1)
  34         __attribute__nonnull__(2);
  35
  36 PARROT_WARN_UNUSED_RESULT
  37 PARROT_CAN_RETURN_NULL
  38 static PMC * internal_ns_keyed(PARROT_INTERP,
  39     ARGIN(PMC *base_ns),
  40     ARGIN(PMC *pmc_key),
  41     int flags)
  42         __attribute__nonnull__(1)
  43         __attribute__nonnull__(2)
  44         __attribute__nonnull__(3);
  45
  46 PARROT_WARN_UNUSED_RESULT
  47 PARROT_CAN_RETURN_NULL
  48 static PMC * internal_ns_keyed_key(PARROT_INTERP,
  49     ARGIN(PMC *ns),
  50     ARGIN(PMC *key),
  51     int flags)
  52         __attribute__nonnull__(1)
  53         __attribute__nonnull__(2)
  54         __attribute__nonnull__(3);
  55
  56 PARROT_WARN_UNUSED_RESULT
  57 PARROT_CAN_RETURN_NULL
  58 static PMC * internal_ns_keyed_str(PARROT_INTERP,
  59     ARGIN(PMC *base_ns),
  60     ARGIN(STRING *key),
  61     int flags)
  62         __attribute__nonnull__(1)
  63         __attribute__nonnull__(2)
  64         __attribute__nonnull__(3);
  65
  66 PARROT_WARN_UNUSED_RESULT
  67 PARROT_CAN_RETURN_NULL
  68 static PMC * internal_ns_maybe_create(PARROT_INTERP,
  69     ARGIN(PMC *ns),
  70     ARGIN(STRING *key),
  71     int flags)
  72         __attribute__nonnull__(1)
  73         __attribute__nonnull__(2)
  74         __attribute__nonnull__(3);
  75
  76 static void store_sub_in_multi(PARROT_INTERP,
  77     ARGIN(PMC *sub_pmc),
  78     ARGIN(PMC *ns))
  79         __attribute__nonnull__(1)
  80         __attribute__nonnull__(2)
  81         __attribute__nonnull__(3);
  82
  83 #define ASSERT_ARGS_get_namespace_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
  84        PARROT_ASSERT_ARG(interp) \
  85     , PARROT_ASSERT_ARG(sub_pmc))
  86 #define ASSERT_ARGS_internal_ns_keyed __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
  87        PARROT_ASSERT_ARG(interp) \
  88     , PARROT_ASSERT_ARG(base_ns) \
  89     , PARROT_ASSERT_ARG(pmc_key))
  90 #define ASSERT_ARGS_internal_ns_keyed_key __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
  91        PARROT_ASSERT_ARG(interp) \
  92     , PARROT_ASSERT_ARG(ns) \
  93     , PARROT_ASSERT_ARG(key))
  94 #define ASSERT_ARGS_internal_ns_keyed_str __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
  95        PARROT_ASSERT_ARG(interp) \
  96     , PARROT_ASSERT_ARG(base_ns) \
  97     , PARROT_ASSERT_ARG(key))
  98 #define ASSERT_ARGS_internal_ns_maybe_create __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
  99        PARROT_ASSERT_ARG(interp) \
 100     , PARROT_ASSERT_ARG(ns) \
 101     , PARROT_ASSERT_ARG(key))
 102 #define ASSERT_ARGS_store_sub_in_multi __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 103        PARROT_ASSERT_ARG(interp) \
 104     , PARROT_ASSERT_ARG(sub_pmc) \
 105     , PARROT_ASSERT_ARG(ns))
 106 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
 107 /* HEADERIZER END: static */
 108
 109 #define DEBUG_GLOBAL 0
 110
 111 /* flags for internal_ns_keyed */
 112 #define INTERN_NS_CREAT 1       /* I'm a fan of the classics */
 113
 114 /*
 115
 116 =item C<static PMC * internal_ns_keyed_str(PARROT_INTERP, PMC *base_ns, STRING
 117 *key, int flags)>
 118
 119 Internal function to do keyed namespace lookup relative to a given namespace
 120 PMC.  Understands STRINGs.
 121
 122 =cut
 123
 124 */
 125
 126 PARROT_WARN_UNUSED_RESULT
 127 PARROT_CAN_RETURN_NULL
 128 static PMC *
 129 internal_ns_keyed_str(PARROT_INTERP, ARGIN(PMC *base_ns),
 130     ARGIN(STRING *key), int flags)
 131 {
 132     ASSERT_ARGS(internal_ns_keyed_str)
 133     PMC * const ns = VTABLE_get_pmc_keyed_str(interp, base_ns, key);
 134
 135     if (!PMC_IS_NULL(ns) && VTABLE_isa(interp, ns, CONST_STRING(interp, "NameSpace")))
 136         return ns;
 137
 138     return internal_ns_maybe_create(interp, base_ns, key, flags);
 139 }
 140
 141 /*
 142
 143 =item C<static PMC * internal_ns_keyed_key(PARROT_INTERP, PMC *ns, PMC *key, int
 144 flags)>
 145
 146 Internal function to do keyed namespace lookup relative to a given namespace
 147 PMC.  Understands Key PMCs.  Used from C<internal_ns_keyed>.
 148
 149 =cut
 150
 151 */
 152
 153 PARROT_WARN_UNUSED_RESULT
 154 PARROT_CAN_RETURN_NULL
 155 static PMC *
 156 internal_ns_keyed_key(PARROT_INTERP, ARGIN(PMC *ns), ARGIN(PMC *key), int flags)
 157 {
 158     ASSERT_ARGS(internal_ns_keyed_key)
 159     while (key) {
 160         STRING * const part = VTABLE_get_string(interp, key);
 161         PMC    *sub_ns      = VTABLE_get_pmc_keyed_str(interp, ns, part);
 162
 163         if (PMC_IS_NULL(sub_ns) || !VTABLE_isa(interp, sub_ns, CONST_STRING(interp, "NameSpace"))) {
 164             sub_ns = internal_ns_maybe_create(interp, ns, part, flags);
 165
 166             if (PMC_IS_NULL(sub_ns))
 167                 return PMCNULL;
 168         }
 169
 170         ns  = sub_ns;
 171         key = VTABLE_shift_pmc(interp, key);
 172     }
 173
 174     return ns;
 175 }
 176
 177 /*
 178
 179 =item C<static PMC * internal_ns_keyed(PARROT_INTERP, PMC *base_ns, PMC
 180 *pmc_key, int flags)>
 181
 182 internal_ns_keyed: Internal function to do keyed namespace lookup relative to a
 183 given namespace PMC.  Understands String, Key, and array PMCs containing
 184 strings.
 185
 186 =cut
 187
 188 */
 189
 190 PARROT_WARN_UNUSED_RESULT
 191 PARROT_CAN_RETURN_NULL
 192 static PMC *
 193 internal_ns_keyed(PARROT_INTERP, ARGIN(PMC *base_ns), ARGIN(PMC *pmc_key), int flags)
 194 {
 195     ASSERT_ARGS(internal_ns_keyed)
 196
 197     if (VTABLE_isa(interp, pmc_key, CONST_STRING(interp, "String"))) {
 198         STRING * const str_key = VTABLE_get_string(interp, pmc_key);
 199         return internal_ns_keyed_str(interp, base_ns, str_key, flags);
 200     }
 201     else if (pmc_key->vtable->base_type == enum_class_Key)
 202         return internal_ns_keyed_key(interp, base_ns, pmc_key, flags);
 203     else {
 204         /* array of strings */
 205         STRING * const isans = CONST_STRING(interp, "NameSpace");
 206         const INTVAL n = VTABLE_elements(interp, pmc_key);
 207         INTVAL i;
 208         PMC *ns = base_ns;
 209
 210         for (i = 0; i < n; ++i) {
 211             STRING * const part = VTABLE_get_string_keyed_int(interp, pmc_key, i);
 212             PMC *sub_ns = VTABLE_get_pmc_keyed_str(interp, ns, part);
 213
 214             if (PMC_IS_NULL(sub_ns) || !VTABLE_isa(interp, sub_ns, isans)) {
 215                 sub_ns = internal_ns_maybe_create(interp, ns, part, flags);
 216                 if (PMC_IS_NULL(sub_ns))
 217                     return PMCNULL;
 218             }
 219             ns = sub_ns;
 220         }
 221         return ns;
 222     }
 223 }
 224
 225 /*
 226
 227 =item C<static PMC * internal_ns_maybe_create(PARROT_INTERP, PMC *ns, STRING
 228 *key, int flags)>
 229
 230 Given the a namespace PMC, a STRING containing a name, and flags from
 231 C<internal_ns_keyed> or C<internal_ns_keyed_str>, creates and returns a new
 232 namespace with the given name in the given namespace.  This is an internal
 233 function only.
 234
 235 =cut
 236
 237 */
 238
 239 PARROT_WARN_UNUSED_RESULT
 240 PARROT_CAN_RETURN_NULL
 241 static PMC *
 242 internal_ns_maybe_create(PARROT_INTERP, ARGIN(PMC *ns), ARGIN(STRING *key), int flags)
 243 {
 244     ASSERT_ARGS(internal_ns_maybe_create)
 245     PMC *sub_ns;
 246
 247     /* TT #1220 - stop depending on typed namespace */
 248     if (!(flags & INTERN_NS_CREAT))
 249         return PMCNULL;
 250
 251     /* TT #1221 - match HLL of enclosing namespace? */
 252     sub_ns = Parrot_pmc_new(interp, Parrot_get_ctx_HLL_type(interp,
 253                                                  enum_class_NameSpace));
 254
 255     if (PMC_IS_NULL(sub_ns))
 256         return PMCNULL;
 257
 258     VTABLE_set_pmc_keyed_str(interp, ns, key, sub_ns);
 259
 260     return sub_ns;
 261 }
 262
 263
 264 /*
 265
 266 =item C<PMC * Parrot_get_namespace_keyed(PARROT_INTERP, PMC *base_ns, PMC
 267 *pmc_key)>
 268
 269 Find the namespace relative to the namespace C<base_ns> with the key
 270 C<pmc_key>, which may be a String, a Key, or an array of strings.  Return
 271 the namespace, or NULL if not found.
 272
 273 =cut
 274
 275 */
 276
 277 PARROT_EXPORT
 278 PARROT_WARN_UNUSED_RESULT
 279 PARROT_CAN_RETURN_NULL
 280 PMC *
 281 Parrot_get_namespace_keyed(PARROT_INTERP, ARGIN(PMC *base_ns), ARGIN(PMC *pmc_key))
 282 {
 283     ASSERT_ARGS(Parrot_get_namespace_keyed)
 284     return internal_ns_keyed(interp, base_ns, pmc_key, 0);
 285 }
 286
 287 /*
 288
 289 =item C<PMC * Parrot_get_namespace_keyed_str(PARROT_INTERP, PMC *base_ns, STRING
 290 *str_key)>
 291
 292 Find the namespace relative to the namespace C<base_ns> with the string key
 293 C<str_key>.  Return the namespace, or NULL if not found.
 294
 295 =cut
 296
 297 */
 298
 299 PARROT_EXPORT
 300 PARROT_WARN_UNUSED_RESULT
 301 PARROT_CAN_RETURN_NULL
 302 PMC *
 303 Parrot_get_namespace_keyed_str(PARROT_INTERP, ARGIN(PMC *base_ns),
 304         ARGIN_NULLOK(STRING *str_key))
 305 {
 306     ASSERT_ARGS(Parrot_get_namespace_keyed_str)
 307     return internal_ns_keyed_str(interp, base_ns, str_key, 0);
 308 }
 309
 310 /*
 311
 312 =item C<PMC * Parrot_make_namespace_keyed(PARROT_INTERP, PMC *base_ns, PMC
 313 *pmc_key)>
 314
 315 Find, or create if necessary, the namespace relative to the namespace
 316 C<base_ns> with the key C<pmc_key>, which may be a String, a Key, or an
 317 array of strings.  Return the namespace.  Errors will result in exceptions.
 318
 319 =cut
 320
 321 */
 322
 323 PARROT_EXPORT
 324 PARROT_WARN_UNUSED_RESULT
 325 PARROT_CAN_RETURN_NULL
 326 PMC *
 327 Parrot_make_namespace_keyed(PARROT_INTERP, ARGIN(PMC *base_ns),
 328         ARGIN(PMC *pmc_key))
 329 {
 330     ASSERT_ARGS(Parrot_make_namespace_keyed)
 331     return internal_ns_keyed(interp, base_ns, pmc_key, INTERN_NS_CREAT);
 332 }
 333
 334 /*
 335
 336 =item C<PMC * Parrot_make_namespace_keyed_str(PARROT_INTERP, PMC *base_ns,
 337 STRING *str_key)>
 338
 339 Find, or create if necessary, the namespace relative to the namespace
 340 C<base_ns> with the string key C<str_key>.  Return the namespace.  Errors
 341 will result in exceptions.
 342
 343 =cut
 344
 345 */
 346
 347 PARROT_EXPORT
 348 PARROT_WARN_UNUSED_RESULT
 349 PARROT_CAN_RETURN_NULL
 350 PMC *
 351 Parrot_make_namespace_keyed_str(PARROT_INTERP, ARGIN(PMC *base_ns),
 352         ARGIN(STRING *str_key))
 353 {
 354     ASSERT_ARGS(Parrot_make_namespace_keyed_str)
 355     return internal_ns_keyed_str(interp, base_ns, str_key, INTERN_NS_CREAT);
 356 }
 357
 358
 359 /*
 360
 361 =item C<PMC * Parrot_make_namespace_autobase(PARROT_INTERP, PMC *key)>
 362
 363 Find, or create if necessary, a namespace with the key C<key>, which may be a
 364 String, a Key, or an array of strings. If it is a String, then the lookup is
 365 relative to the current namespace. Otherwise, it is relative to the current HLL
 366 root namespace. Return the namespace.  Errors will result in exceptions.
 367
 368 =cut
 369
 370 */
 371
 372 PARROT_EXPORT
 373 PARROT_WARN_UNUSED_RESULT
 374 PARROT_CAN_RETURN_NULL
 375 PMC *
 376 Parrot_make_namespace_autobase(PARROT_INTERP, ARGIN_NULLOK(PMC *key))
 377 {
 378     ASSERT_ARGS(Parrot_make_namespace_autobase)
 379     PMC *base_ns;
 380     if (VTABLE_isa(interp, key, CONST_STRING(interp, "String")))
 381         base_ns = Parrot_pcc_get_namespace(interp, CURRENT_CONTEXT(interp));
 382     else
 383         base_ns = VTABLE_get_pmc_keyed_int(interp, interp->HLL_namespace,
 384             Parrot_pcc_get_HLL(interp, CURRENT_CONTEXT(interp)));
 385     return Parrot_make_namespace_keyed(interp, base_ns, key);
 386 }
 387
 388 /*
 389
 390 =item C<PMC * Parrot_ns_get_name(PARROT_INTERP, PMC *_namespace)>
 391
 392 Retrieve an array of names from a namespace object.
 393
 394 =cut
 395
 396 */
 397
 398 PARROT_EXPORT
 399 PARROT_WARN_UNUSED_RESULT
 400 PARROT_CAN_RETURN_NULL
 401 PMC *
 402 Parrot_ns_get_name(PARROT_INTERP, ARGIN(PMC *_namespace))
 403 {
 404     ASSERT_ARGS(Parrot_ns_get_name)
 405     PMC *names;
 406     Parrot_pcc_invoke_method_from_c_args(interp, _namespace, CONST_STRING(interp, "get_name"), "->P", &names);
 407     return names;
 408 }
 409
 410 /*
 411
 412 =item C<PMC * Parrot_get_global(PARROT_INTERP, PMC *ns, STRING *globalname)>
 413
 414 Parrot_get_global allows a null namespace without throwing an exception; it
 415 simply returns PMCNULL in that case.
 416
 417 NOTE: At present the use of the {get, set}_global functions is mandatory due to the
 418       wacky namespace typing of the default Parrot namespace.  Eventually it will be
 419       safe to just use the standard hash interface (if desired).
 420
 421 Look up the global named C<globalname> in the namespace C<ns>.  Return the
 422 global, or return PMCNULL if C<ns> is null or if the global is not found.
 423
 424 KLUDGE ALERT: Currently prefers non-namespaces in case of collision.
 425
 426 =cut
 427
 428 */
 429
 430
 431 /*
 432  * {get, set}_global.
 433  *
 434  * Parrot_get_global allows a null namespace without throwing an exception; it
 435  * simply returns PMCNULL in that case.
 436  *
 437  * NOTE: At present the use of the {get, set}_global functions is mandatory due to the
 438  *       wacky namespace typing of the default Parrot namespace.  Eventually it will be
 439  *       safe to just use the standard hash interface (if desired).
 440  */
 441
 442 PARROT_EXPORT
 443 PARROT_WARN_UNUSED_RESULT
 444 PARROT_CAN_RETURN_NULL
 445 PMC *
 446 Parrot_get_global(PARROT_INTERP, ARGIN_NULLOK(PMC *ns), ARGIN_NULLOK(STRING *globalname))
 447 {
 448     ASSERT_ARGS(Parrot_get_global)
 449     if (PMC_IS_NULL(ns))
 450         return PMCNULL;
 451
 452     return (PMC *)VTABLE_get_pointer_keyed_str(interp, ns, globalname);
 453 }
 454
 455 /*
 456
 457 =item C<void Parrot_set_global(PARROT_INTERP, PMC *ns, STRING *globalname, PMC
 458 *val)>
 459
 460 Set the global named C<globalname> in the namespace C<ns> to the value C<val>.
 461
 462 =cut
 463
 464 */
 465
 466 PARROT_EXPORT
 467 void
 468 Parrot_set_global(PARROT_INTERP, ARGIN_NULLOK(PMC *ns),
 469         ARGIN_NULLOK(STRING *globalname), ARGIN_NULLOK(PMC *val))
 470 {
 471     ASSERT_ARGS(Parrot_set_global)
 472     VTABLE_set_pmc_keyed_str(interp, ns, globalname, val);
 473 }
 474
 475
 476 /*
 477
 478 =item C<PMC * Parrot_find_global_n(PARROT_INTERP, PMC *ns, STRING *globalname)>
 479
 480 Search the namespace PMC C<ns> for an object with name C<globalname>.
 481 Return the object, or NULL if not found.
 482
 483 TT #1222 - For now this function prefers non-namespaces, it will eventually
 484 entirely use the untyped interface.
 485
 486 =cut
 487
 488 */
 489
 490 PARROT_EXPORT
 491 PARROT_WARN_UNUSED_RESULT
 492 PARROT_CAN_RETURN_NULL
 493 PMC *
 494 Parrot_find_global_n(PARROT_INTERP, ARGIN_NULLOK(PMC *ns), ARGIN_NULLOK(STRING *globalname))
 495 {
 496     ASSERT_ARGS(Parrot_find_global_n)
 497     PMC *res;
 498
 499 #if DEBUG_GLOBAL
 500     if (globalname)
 501         Parrot_io_printf(interp, "find_global name '%Ss'\n", globalname);
 502 #endif
 503
 504     if (PMC_IS_NULL(ns))
 505         res = PMCNULL;
 506     else {
 507         /*
 508          * TT #1219 - we should be able to use 'get_pmc_keyed' here,
 509          * but we can't because Parrot's default namespaces are not
 510          * fully typed and there's a pseudo-typed interface that
 511          * distinguishes 'get_pmc_keyed' from 'get_pointer_keyed';
 512          * the former is for NS and the latter is for non-NS.
 513          */
 514         res = (PMC *)VTABLE_get_pointer_keyed_str(interp, ns, globalname);
 515     }
 516
 517     return PMC_IS_NULL(res) ? NULL : res;
 518 }
 519
 520 /*
 521
 522 =item C<PMC * Parrot_find_global_cur(PARROT_INTERP, STRING *globalname)>
 523
 524 Finds and returns the data time named C<globalname> in the current namespace.
 525
 526 =cut
 527
 528 */
 529
 530 PARROT_EXPORT
 531 PARROT_WARN_UNUSED_RESULT
 532 PARROT_CAN_RETURN_NULL
 533 PMC *
 534 Parrot_find_global_cur(PARROT_INTERP, ARGIN_NULLOK(STRING *globalname))
 535 {
 536     ASSERT_ARGS(Parrot_find_global_cur)
 537     PMC * const ns = Parrot_pcc_get_namespace(interp, CURRENT_CONTEXT(interp));
 538     return Parrot_find_global_n(interp, ns, globalname);
 539 }
 540
 541 /*
 542
 543 =item C<PMC * Parrot_find_global_s(PARROT_INTERP, STRING *str_key, STRING
 544 *globalname)>
 545
 546 Search the namespace designated by C<str_key>, or the HLL root if
 547 C<str_key> is NULL, for an object with name C<globalname>.  Return the
 548 object, or NULL if not found.
 549
 550 TT #1222 - For now this function prefers non-namespaces, it will eventually
 551 entirely use the untyped interface.
 552
 553 =cut
 554
 555 */
 556
 557 PARROT_EXPORT
 558 PARROT_WARN_UNUSED_RESULT
 559 PARROT_CAN_RETURN_NULL
 560 PMC *
 561 Parrot_find_global_s(PARROT_INTERP, ARGIN_NULLOK(STRING *str_key),
 562         ARGIN_NULLOK(STRING *globalname))
 563 {
 564     ASSERT_ARGS(Parrot_find_global_s)
 565     PMC *const ns =
 566         Parrot_get_namespace_keyed_str(interp,
 567                                        Parrot_get_ctx_HLL_namespace(interp),
 568                                        str_key);
 569     return Parrot_find_global_n(interp, ns, globalname);
 570 }
 571
 572 /*
 573
 574 =item C<void Parrot_store_global_n(PARROT_INTERP, PMC *ns, STRING *globalname,
 575 PMC *val)>
 576
 577 Store the PMC C<val> into the namespace PMC C<ns> with name C<globalname>.
 578
 579 =cut
 580
 581 */
 582
 583 PARROT_EXPORT
 584 void
 585 Parrot_store_global_n(PARROT_INTERP, ARGIN_NULLOK(PMC *ns),
 586         ARGIN_NULLOK(STRING *globalname), ARGIN_NULLOK(PMC *val))
 587 {
 588     ASSERT_ARGS(Parrot_store_global_n)
 589 #if DEBUG_GLOBAL
 590     if (globalname)
 591         Parrot_io_printf(interp, "store_global name '%Ss'\n", globalname);
 592 #endif
 593
 594     if (PMC_IS_NULL(ns))
 595         return;
 596
 597     VTABLE_set_pmc_keyed_str(interp, ns, globalname, val);
 598 }
 599
 600 /*
 601
 602 =item C<void Parrot_store_global_s(PARROT_INTERP, STRING *str_key, STRING
 603 *globalname, PMC *val)>
 604
 605 Store the PMC C<val> into the namespace designated by C<str_key>, or
 606 the HLL root if C<str_key> is NULL, with the name C<globalname>.
 607
 608 =cut
 609
 610 */
 611
 612 PARROT_EXPORT
 613 void
 614 Parrot_store_global_s(PARROT_INTERP, ARGIN_NULLOK(STRING *str_key),
 615         ARGIN_NULLOK(STRING *globalname), ARGIN_NULLOK(PMC *val))
 616 {
 617     ASSERT_ARGS(Parrot_store_global_s)
 618     PMC * const ns = Parrot_make_namespace_keyed_str(interp,
 619                                          Parrot_get_ctx_HLL_namespace(interp),
 620                                          str_key);
 621
 622     Parrot_store_global_n(interp, ns, globalname, val);
 623
 624     /* TT #1225 - method cache invalidation should be a namespace function */
 625     Parrot_invalidate_method_cache(interp, str_key);
 626 }
 627
 628
 629 /*
 630
 631 =item C<PMC * Parrot_find_global_op(PARROT_INTERP, PMC *ns, STRING *globalname,
 632 void *next)>
 633
 634 If the global exists in the given namespace PMC, return it.  If not, return
 635 PMCNULL.
 636
 637 =cut
 638
 639 */
 640
 641 PARROT_EXPORT
 642 PARROT_WARN_UNUSED_RESULT
 643 PARROT_CANNOT_RETURN_NULL
 644 PMC *
 645 Parrot_find_global_op(PARROT_INTERP, ARGIN(PMC *ns),
 646         ARGIN_NULLOK(STRING *globalname), ARGIN_NULLOK(void *next))
 647 {
 648     ASSERT_ARGS(Parrot_find_global_op)
 649     PMC *res;
 650
 651     if (STRING_IS_NULL(globalname))
 652         Parrot_ex_throw_from_c_args(interp, next, EXCEPTION_GLOBAL_NOT_FOUND,
 653             "Tried to get null global");
 654
 655     res = Parrot_find_global_n(interp, ns, globalname);
 656     if (!res)
 657         res = PMCNULL;
 658
 659     return res;
 660 }
 661
 662
 663 /*
 664
 665 =item C<PMC * Parrot_find_name_op(PARROT_INTERP, STRING *name, void *next)>
 666
 667 TT #1223 - THIS IS BROKEN - it doesn't walk up the scopes yet
 668
 669 Find the given C<name> in lexicals, then the current namespace, then the HLL
 670 root namespace, and finally Parrot builtins.  If the name isn't found
 671 anywhere, return PMCNULL.
 672
 673 =cut
 674
 675 */
 676
 677 PARROT_EXPORT
 678 PARROT_WARN_UNUSED_RESULT
 679 PARROT_CAN_RETURN_NULL
 680 PMC *
 681 Parrot_find_name_op(PARROT_INTERP, ARGIN(STRING *name), SHIM(void *next))
 682 {
 683     ASSERT_ARGS(Parrot_find_name_op)
 684     PMC * const ctx     = CURRENT_CONTEXT(interp);
 685     PMC * const lex_pad = Parrot_find_pad(interp, name, ctx);
 686     PMC *g;
 687
 688     if (PMC_IS_NULL(lex_pad))
 689         g = PMCNULL;
 690     else
 691         g = VTABLE_get_pmc_keyed_str(interp, lex_pad, name);
 692
 693     /* TT #1223 - walk up the scopes!  duh!! */
 694
 695     if (PMC_IS_NULL(g))
 696         g = Parrot_find_global_cur(interp, name);
 697
 698     if (PMC_IS_NULL(g))
 699         g = Parrot_find_global_n(interp, Parrot_get_ctx_HLL_namespace(interp), name);
 700
 701     if (PMC_IS_NULL(g))
 702         return PMCNULL;
 703     else
 704         return g;
 705 }
 706
 707 /*
 708
 709 =item C<static PMC * get_namespace_pmc(PARROT_INTERP, PMC *sub_pmc)>
 710
 711 Return the namespace PMC associated with the PMC C<sub>. If C<sub> is NULL,
 712 return the Associated HLL namespace PMC instead.
 713
 714 =cut
 715
 716 */
 717
 718 PARROT_WARN_UNUSED_RESULT
 719 PARROT_CAN_RETURN_NULL
 720 static PMC *
 721 get_namespace_pmc(PARROT_INTERP, ARGIN(PMC *sub_pmc))
 722 {
 723     ASSERT_ARGS(get_namespace_pmc)
 724     Parrot_Sub_attributes *sub;
 725     PMC        *nsname, *nsroot;
 726
 727     PMC_get_sub(interp, sub_pmc, sub);
 728     nsname = sub->namespace_name;
 729     nsroot = Parrot_get_HLL_namespace(interp, sub->HLL_id);
 730
 731     /* If we have a NULL, return the HLL namespace */
 732     if (PMC_IS_NULL(nsname))
 733         return nsroot;
 734     /* If we have a String, do a string lookup */
 735     else if (nsname->vtable->base_type == enum_class_String)
 736         return Parrot_make_namespace_keyed_str(interp, nsroot,
 737                 VTABLE_get_string(interp, nsname));
 738     /* Otherwise, do a PMC lookup */
 739     else
 740         return Parrot_make_namespace_keyed(interp, nsroot, nsname);
 741 }
 742
 743 /*
 744
 745 =item C<static void store_sub_in_multi(PARROT_INTERP, PMC *sub_pmc, PMC *ns)>
 746
 747 Adds the sub C<sub> into a mulisub of the same name in the namespace C<ns>.
 748 If no multisub by that name currently exists, we create one.
 749
 750 =cut
 751
 752 */
 753
 754 static void
 755 store_sub_in_multi(PARROT_INTERP, ARGIN(PMC *sub_pmc), ARGIN(PMC *ns))
 756 {
 757     ASSERT_ARGS(store_sub_in_multi)
 758     Parrot_Sub_attributes *sub;
 759     STRING     *ns_entry_name;
 760     PMC        *multisub;
 761
 762     PMC_get_sub(interp, sub_pmc, sub);
 763     ns_entry_name = sub->ns_entry_name;
 764     multisub      = VTABLE_get_pmc_keyed_str(interp, ns, ns_entry_name);
 765
 766     /* is there an existing MultiSub PMC? or do we need to create one? */
 767     if (PMC_IS_NULL(multisub)) {
 768         multisub = Parrot_pmc_new(interp,  Parrot_get_ctx_HLL_type(interp, enum_class_MultiSub));
 769         /* we have to push the sub onto the MultiSub before we try to store
 770         it because storing requires information from the sub */
 771         VTABLE_push_pmc(interp, multisub, sub_pmc);
 772         VTABLE_set_pmc_keyed_str(interp, ns, ns_entry_name, multisub);
 773     }
 774     else
 775         VTABLE_push_pmc(interp, multisub, sub_pmc);
 776 }
 777
 778 /*
 779
 780 =item C<void Parrot_store_sub_in_namespace(PARROT_INTERP, PMC *sub_pmc)>
 781
 782 Adds the PMC C<sub> into the current namespace. Adds the sub to a multi of the
 783 same name if it's defined as a multi.
 784
 785 =cut
 786
 787 */
 788
 789 PARROT_EXPORT
 790 void
 791 Parrot_store_sub_in_namespace(PARROT_INTERP, ARGIN(PMC *sub_pmc))
 792 {
 793     ASSERT_ARGS(Parrot_store_sub_in_namespace)
 794     const INTVAL cur_id = Parrot_pcc_get_HLL(interp, CURRENT_CONTEXT(interp));
 795
 796     PMC        *ns;
 797     Parrot_Sub_attributes *sub;
 798
 799     /* PF structures aren't fully constructed yet */
 800     Parrot_block_GC_mark(interp);
 801
 802     /* store relative to HLL namespace */
 803     PMC_get_sub(interp, sub_pmc, sub);
 804     Parrot_pcc_set_HLL(interp, CURRENT_CONTEXT(interp), sub->HLL_id);
 805
 806     ns = get_namespace_pmc(interp, sub_pmc);
 807
 808     /* attach a namespace to the sub for lookups */
 809     sub->namespace_stash = ns;
 810
 811     /* store a :multi sub */
 812     if (!PMC_IS_NULL(sub->multi_signature))
 813         store_sub_in_multi(interp, sub_pmc, ns);
 814
 815     /* store other subs (as long as they're not :anon) */
 816     else if (!(PObj_get_FLAGS(sub_pmc) & SUB_FLAG_PF_ANON)
 817         || sub->vtable_index != -1) {
 818         STRING * const ns_entry_name = sub->ns_entry_name;
 819         PMC    * const nsname        = sub->namespace_name;
 820
 821         Parrot_store_global_n(interp, ns, ns_entry_name, sub_pmc);
 822
 823         /* TT #1224:
 824            TEMPORARY HACK - cache invalidation should be a namespace function */
 825         if (!PMC_IS_NULL(nsname)) {
 826             STRING * const nsname_s = VTABLE_get_string(interp, nsname);
 827             Parrot_invalidate_method_cache(interp, nsname_s);
 828         }
 829     }
 830
 831     /* restore HLL_id */
 832     Parrot_pcc_set_HLL(interp, CURRENT_CONTEXT(interp), cur_id);
 833     Parrot_unblock_GC_mark(interp);
 834 }
 835
 836 /*
 837
 838 =back
 839
 840 =head1 SEE ALSO
 841
 842 F<include/parrot/global.h>
 843
 844 =cut
 845
 846 */
 847
 848
 849 /*
 850  * Local variables:
 851  *   c-file-style: "parrot"
 852  * End:
 853  * vim: expandtab shiftwidth=4:
 854  */