src/global.c

   1 /*
   2 Copyright (C) 2004, The Perl Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 src/global.c - Access to global PMCs
   8
   9 =head1 DESCRIPTION
  10
  11 tdb
  12
  13 =head2 Functions
  14
  15 tdb
  16
  17 =over 4
  18
  19 =cut
  20
  21 */
  22
  23 #include "parrot/parrot.h"
  24 #include "global.str"
  25
  26 #define DEBUG_GLOBAL 0
  27
  28 /*
  29  * internal_ns_keyed: Internal function to do keyed namespace lookup
  30  * relative to a given namespace PMC.  Understands STRINGs, String PMCs,
  31  * Key pmcs, and array PMCs containing strings.
  32  */
  33
  34 /* flags for internal_ns_keyed */
  35 #define INTERN_NS_CREAT 1       /* I'm a fan of the classics */
  36
  37 static PMC * internal_ns_keyed(Interp *interp, PMC *base_ns, PMC *pmc_key,
  38                                STRING *str_key, int flags)
  39 {
  40     PMC *ns, *sub_ns;
  41     INTVAL i, n;
  42     static const INTVAL max_intval = (INTVAL)((~(UINTVAL)0) >> 1); /*2s comp*/
  43
  44     ns = base_ns;
  45
  46     if (str_key)
  47         n = 1;
  48     else if (pmc_key->vtable->base_type == enum_class_String) {
  49         str_key = VTABLE_get_string(interp, pmc_key);
  50         n = 1;
  51     }
  52     else if (pmc_key->vtable->base_type == enum_class_Key)
  53         n = max_intval;         /* we don't yet know how big the key is */
  54     else
  55         n = VTABLE_elements(interp, pmc_key); /* array of strings */
  56
  57     for (i = 0; i < n; ++i) {
  58         STRING *part;
  59
  60         if (str_key)
  61             part = str_key;
  62         else if (n == max_intval) {
  63             part = key_string(interp, pmc_key);
  64             pmc_key = key_next(interp, pmc_key);
  65             if (! pmc_key)
  66                 n = i + 1;      /* now we know how big the key is */
  67         }
  68         else
  69             part = VTABLE_get_string_keyed_int(interp, pmc_key, i);
  70
  71         sub_ns = VTABLE_get_pmc_keyed_str(interp, ns, part);
  72
  73         if (PMC_IS_NULL(sub_ns)
  74             /* TODO - stop depending on typed namespace */
  75             || sub_ns->vtable->base_type != enum_class_NameSpace)
  76         {
  77             if (!(flags & INTERN_NS_CREAT))
  78                 return PMCNULL;
  79
  80             /* TODO - match HLL of enclosing namespace? */
  81             sub_ns = pmc_new(interp,
  82                              Parrot_get_ctx_HLL_type(interp,
  83                                                      enum_class_NameSpace));
  84             if (PMC_IS_NULL(sub_ns))
  85                 return PMCNULL;
  86             VTABLE_set_pmc_keyed_str(interp, ns, part, sub_ns);
  87         }
  88
  89         ns = sub_ns;
  90     }
  91
  92     return ns;
  93 }
  94
  95 /*
  96
  97 =item C<PMC *
  98 Parrot_get_namespace_keyed(Interp *, PMC *base_ns, PMC *pmc_key)>
  99
 100 Find the namespace relative to the namespace C<base_ns> with the key
 101 C<pmc_key>, which may be a String, a Key, or an array of strings.  Return
 102 the namespace, or NULL if not found.
 103
 104 =item C<PMC *
 105 Parrot_get_namespace_keyed_str(Interp *, PMC *base_ns, STRING *str_key)>
 106
 107 Find the namespace relative to the namespace C<base_ns> with the string key
 108 C<str_key>.  Return the namespace, or NULL if not found.
 109
 110 =item C<PMC *
 111 Parrot_make_namespace_keyed(Interp *, PMC *base_ns, PMC *pmc_key)>
 112
 113 Find, or create if necessary, the namespace relative to the namespace
 114 C<base_ns> with the key C<pmc_key>, which may be a String, a Key, or an
 115 array of strings.  Return the namespace.  Errors will result in exceptions.
 116
 117 =item C<PMC *
 118 Parrot_make_namespace_keyed_str(Interp *, PMC *base_ns, STRING *str_key)>
 119
 120 Find, or create if necessary, the namespace relative to the namespace
 121 C<base_ns> with the string key C<str_key>.  Return the namespace.  Errors
 122 will result in exceptions.
 123
 124 =cut
 125
 126 */
 127
 128
 129 PMC *
 130 Parrot_get_namespace_keyed(Interp *interp, PMC *base_ns, PMC *pmc_key)
 131 {
 132     return internal_ns_keyed(interp, base_ns,
 133                              pmc_key, NULL, 0);
 134 }
 135
 136 PMC *
 137 Parrot_get_namespace_keyed_str(Interp *interp, PMC *base_ns, STRING *str_key)
 138 {
 139     return internal_ns_keyed(interp, base_ns,
 140                              PMCNULL, str_key, 0);
 141 }
 142
 143 PMC *
 144 Parrot_make_namespace_keyed(Interp *interp, PMC *base_ns, PMC *pmc_key)
 145 {
 146     return internal_ns_keyed(interp, base_ns,
 147                              pmc_key, NULL, INTERN_NS_CREAT);
 148 }
 149
 150 PMC *
 151 Parrot_make_namespace_keyed_str(Interp *interp, PMC *base_ns, STRING *str_key)
 152 {
 153     return internal_ns_keyed(interp, base_ns,
 154                              NULL, str_key, INTERN_NS_CREAT);
 155 }
 156
 157
 158 /*
 159
 160 =item C<PMC *
 161 Parrot_get_namespace_autobase(Interp *, PMC *key)>
 162
 163 Find a namespace with the key C<key>, which may be a String, a Key, or an
 164 array of strings. If it is a String, then the lookup is relative to the
 165 current namespace. Otherwise, it is relative to the current HLL root
 166 namespace. Return the namespace, or NULL if not found.
 167
 168 =item C<PMC *
 169 Parrot_make_namespace_autobase(Interp *, PMC *pmc_key)>
 170
 171 Find, or create if necessary, a namespace with the key C<key>, which may be a
 172 String, a Key, or an array of strings. If it is a String, then the lookup is
 173 relative to the current namespace. Otherwise, it is relative to the current HLL
 174 root namespace. Return the namespace.  Errors will result in exceptions.
 175
 176 =cut
 177
 178 */
 179
 180
 181 PMC *
 182 Parrot_make_namespace_autobase(Interp *interp, PMC *key)
 183 {
 184     PMC *base_ns;
 185     if (VTABLE_isa(interp, key, string_from_const_cstring(interp, "String", 0)))
 186         base_ns = CONTEXT(interp->ctx)->current_namespace;
 187     else
 188         base_ns = VTABLE_get_pmc_keyed_int(interp, interp->HLL_namespace,
 189             CONTEXT(interp->ctx)->current_HLL);
 190     return Parrot_make_namespace_keyed(interp, base_ns, key);
 191 }
 192
 193 PMC *
 194 Parrot_get_namespace_autobase(Interp *interp, PMC *key)
 195 {
 196     PMC *base_ns;
 197     if (VTABLE_isa(interp, key, string_from_const_cstring(interp, "String", 0)))
 198         base_ns = CONTEXT(interp->ctx)->current_namespace;
 199     else
 200         base_ns = VTABLE_get_pmc_keyed_int(interp, interp->HLL_namespace,
 201             CONTEXT(interp->ctx)->current_HLL);
 202     return Parrot_get_namespace_keyed(interp, base_ns, key);
 203 }
 204
 205
 206 /*
 207
 208 =item C<PMC *
 209 Parrot_get_global(Interp *, PMC *ns, STRING *globalname)>
 210
 211 Look up the global named C<globalname> in the namespace C<ns>.  Return the
 212 global, or return PMCNULL if C<ns> is null or if the global is not found.
 213
 214 KLUDGE ALERT: Currently prefers non-namespaces in case of collision.
 215
 216 =item C<PMC *
 217 Parrot_set_global(Interp *, PMC *ns, STRING *globalname, PMC *val)>
 218
 219 Set the global named C<globalname> in the namespace C<ns> to the value C<val>.
 220
 221 =cut
 222
 223 */
 224
 225 PMC *
 226 Parrot_get_global(Interp *interp, PMC *ns, STRING *globalname)
 227 {
 228     if (PMC_IS_NULL(ns))
 229         return PMCNULL;
 230
 231     return (PMC *)VTABLE_get_pointer_keyed_str(interp, ns, globalname);
 232 }
 233
 234 void
 235 Parrot_set_global(Interp *interp, PMC *ns, STRING *globalname, PMC *val)
 236 {
 237     VTABLE_set_pmc_keyed_str(interp, ns, globalname, val);
 238 }
 239
 240
 241 /*
 242
 243 =item C<PMC *
 244 Parrot_find_global_n(Interp *, PMC *ns, STRING *globalname)>
 245
 246 Search the namespace PMC C<ns> for an object with name C<globalname>.
 247 Return the object, or NULL if not found.
 248
 249 XXX - For now this function prefers non-namespaces, it will eventually
 250 entirely use the untyped interface.
 251
 252 =item C<PMC *
 253 Parrot_find_global_k(Interp *, PMC *pmc_key, STRING *globalname)>
 254
 255 Search the namespace designated by C<pmc_key>, which may be a key PMC,
 256 an array of namespace name strings, or a string PMC, for an object
 257 with name C<globalname>.  Return the object, or NULL if not found.
 258
 259 XXX - For now this function prefers non-namespaces, it will eventually
 260 entirely use the untyped interface.
 261
 262 =item C<PMC *
 263 Parrot_find_global_s(Interp *, STRING *str_key, STRING *globalname)>
 264
 265 Search the namespace designated by C<str_key>, or the HLL root if
 266 C<str_key> is NULL, for an object with name C<globalname>.  Return the
 267 object, or NULL if not found.
 268
 269 XXX - For now this function prefers non-namespaces, it will eventually
 270 entirely use the untyped interface.
 271
 272 =cut
 273
 274 */
 275
 276 PMC *
 277 Parrot_find_global_n(Interp *interp, PMC *ns, STRING *globalname)
 278 {
 279     PMC *res;
 280
 281 #if DEBUG_GLOBAL
 282     if (globalname)
 283         PIO_printf(interp, "find_global name '%Ss'\n", globalname);
 284 #endif
 285
 286     if (PMC_IS_NULL(ns))
 287         res = PMCNULL;
 288     else {
 289         /*
 290          * XXX - we should be able to use 'get_pmc_keyed' here,
 291          * but we can't because Parrot's default namespaces are not
 292          * fully typed and there's a pseudo-typed interface that
 293          * distinguishes 'get_pmc_keyed' from 'get_pointer_keyed';
 294          * the former is for NS and the latter is for non-NS.
 295          */
 296         res = (PMC *)VTABLE_get_pointer_keyed_str(interp, ns, globalname);
 297     }
 298
 299     return PMC_IS_NULL(res) ? NULL : res;
 300 }
 301
 302 PMC *
 303 Parrot_find_global_cur(Interp *interp, STRING *globalname)
 304 {
 305     PMC * const ns = CONTEXT(interp->ctx)->current_namespace;
 306     return Parrot_find_global_n(interp, ns, globalname);
 307 }
 308
 309 PMC *
 310 Parrot_find_global_k(Interp *interp, PMC *pmc_key, STRING *globalname)
 311 {
 312     PMC * const ns =
 313         Parrot_get_namespace_keyed(interp,
 314                                    Parrot_get_ctx_HLL_namespace(interp),
 315                                    pmc_key);
 316     return Parrot_find_global_n(interp, ns, globalname);
 317 }
 318
 319 PMC *
 320 Parrot_find_global_s(Interp *inter, STRING *str_key, STRING *globalname)
 321 {
 322     PMC *const ns =
 323         Parrot_get_namespace_keyed_str(inter,
 324                                        Parrot_get_ctx_HLL_namespace(inter),
 325                                        str_key);
 326     return Parrot_find_global_n(inter, ns, globalname);
 327 }
 328
 329 /*
 330
 331 =item C<PMC *
 332 Parrot_store_global_n(Interp *, PMC *ns, STRING *globalname, PMC *val)>
 333
 334 Store the PMC C<val> into the namespace PMC C<ns> with name C<globalname>.
 335
 336 =item C<PMC *
 337 Parrot_store_global_k(Interp *, PMC *pmc_key, STRING *globalname, PMC *val)>
 338
 339 Store the PMC C<val> into the namespace designated by C<pmc_key>,
 340 which may be a key PMC, an array of namespace name strings, or a
 341 string PMC, with name C<globalname>.
 342
 343 XXX - For now this function prefers non-namespaces, it will eventually
 344 entirely use the untyped interface.
 345
 346 =item C<PMC *
 347 Parrot_store_global_s(Interp *, STRING *str_key, STRING *globalname, PMC *val)>
 348
 349 Store the PMC C<val> into the namespace designated by C<str_key>, or
 350 the HLL root if C<str_key> is NULL, with the name C<globalname>.
 351
 352 =cut
 353
 354 */
 355
 356 void
 357 Parrot_store_global_n(Interp *interp, PMC *ns,
 358                       STRING *globalname, PMC *val)
 359 {
 360 #if DEBUG_GLOBAL
 361     if (globalname)
 362         PIO_printf(interp, "store_global name '%Ss'\n", globalname);
 363 #endif
 364
 365     if (PMC_IS_NULL(ns))
 366         return;
 367
 368     VTABLE_set_pmc_keyed_str(interp, ns, globalname, val);
 369 }
 370
 371 void
 372 Parrot_store_global_cur(Interp *interp, STRING *globalname, PMC *val)
 373 {
 374     Parrot_store_global_n(interp,
 375                           CONTEXT(interp->ctx)->current_namespace,
 376                           globalname, val);
 377
 378     /* FIXME - method cache invalidation should occur */
 379 }
 380
 381 void
 382 Parrot_store_global_k(Interp *interp, PMC *pmc_key,
 383                       STRING *globalname, PMC *val)
 384 {
 385     PMC *ns;
 386
 387     /*
 388      * XXX - temporary hack to notice when key is actually a string, so that
 389      * the legacy logic for invalidating method cache will be called; this is
 390      * not good enough but it avoids regressesions for now
 391      */
 392     if (pmc_key->vtable->base_type == enum_class_String) {
 393         Parrot_store_global_s(interp, PMC_str_val(pmc_key),
 394                               globalname, val);
 395         return;
 396     }
 397
 398     ns = Parrot_make_namespace_keyed(interp,
 399                                      Parrot_get_ctx_HLL_namespace(interp),
 400                                      pmc_key);
 401
 402     Parrot_store_global_n(interp, ns, globalname, val);
 403
 404     /* FIXME - method cache invalidation should occur */
 405 }
 406
 407 void
 408 Parrot_store_global_s(Interp *inter, STRING *str_key,
 409                       STRING *globalname, PMC *val)
 410 {
 411     PMC *ns;
 412
 413     ns = Parrot_make_namespace_keyed_str(inter,
 414                                          Parrot_get_ctx_HLL_namespace(inter),
 415                                          str_key);
 416
 417     Parrot_store_global_n(inter, ns, globalname, val);
 418
 419     /* FIXME - method cache invalidation should be a namespace function */
 420     Parrot_invalidate_method_cache(inter, str_key, globalname);
 421 }
 422
 423
 424 /*
 425
 426 =item C<PMC *
 427 Parrot_find_global_op(Interp *, PMC *ns, STRING *globalname, void *next)>
 428
 429 If the global exists in the given namespace PMC, return it.  If not, return
 430 PMCNULL.
 431
 432 =cut
 433
 434 */
 435
 436 PMC *
 437 Parrot_find_global_op(Interp *interp, PMC *ns,
 438                       STRING *globalname, void *next)
 439 {
 440     PMC *res;
 441
 442     if (!globalname)
 443         real_exception(interp, next, E_NameError,
 444                        "Tried to get null global");
 445
 446     res = Parrot_find_global_n(interp, ns, globalname);
 447     if (!res)
 448         res = PMCNULL;
 449
 450     return res;
 451 }
 452
 453
 454 /*
 455
 456 =item C<PMC *
 457 Parrot_find_name_op(Interp *, STRING *name, void *next)>
 458
 459 TODO - THIS IS BROKEN - it doesn't walk up the scopes yet - TODO
 460
 461 Find the given C<name> in lexicals, then the current namespace, then the HLL
 462 root namespace, and finally Parrot builtins.  If the name isn't found
 463 anywhere, return PMCNULL.
 464
 465 =cut
 466
 467 */
 468
 469 PMC *
 470 Parrot_find_name_op(Interp *interp, STRING *name, void *next)
 471 {
 472     parrot_context_t * const ctx = CONTEXT(interp->ctx);
 473     PMC *g, *lex_pad;
 474
 475     g = PMCNULL;
 476
 477     lex_pad = Parrot_find_pad(interp, name, ctx);
 478     if (!PMC_IS_NULL(lex_pad))
 479         g = VTABLE_get_pmc_keyed_str(interp, lex_pad, name);
 480
 481     /* TODO TODO TODO - walk up the scopes!  duh!! */
 482
 483     if (PMC_IS_NULL(g))
 484         g = Parrot_find_global_cur(interp, name);
 485
 486     if (PMC_IS_NULL(g))
 487         g = Parrot_find_global_n(interp,
 488                                  Parrot_get_ctx_HLL_namespace(interp),
 489                                  name);
 490
 491     if (PMC_IS_NULL(g))
 492         g = Parrot_find_builtin(interp, name);
 493
 494     if (! PMC_IS_NULL(g))
 495         return g;
 496     else
 497         return PMCNULL;
 498 }
 499
 500 static PMC *
 501 get_namespace_pmc(Parrot_Interp interp, PMC *sub)
 502 {
 503     PMC *nsname = PMC_sub(sub)->namespace_name;
 504     PMC *nsroot = Parrot_get_HLL_namespace(interp, PMC_sub(sub)->HLL_id);
 505
 506     /* If we have a NULL, return the HLL namespace */
 507     if (PMC_IS_NULL(nsname))
 508         return nsroot;
 509     /* If we have a String, do a string lookup */
 510     else if (nsname->vtable->base_type == enum_class_String)
 511         return Parrot_make_namespace_keyed_str(interp, nsroot, PMC_str_val(nsname));
 512     /* Otherwise, do a PMC lookup */
 513     else
 514         return Parrot_make_namespace_keyed(interp, nsroot, nsname);
 515 }
 516
 517 static void
 518 store_sub_in_multi(Parrot_Interp interp, PMC *sub, PMC *ns)
 519 {
 520     INTVAL func_nr;
 521     char *c_meth;
 522     STRING *subname = PMC_sub(sub)->name;
 523     PMC   *multisub = VTABLE_get_pmc_keyed_str(interp, ns, subname);
 524
 525     /* is there an existing MultiSub PMC? or do we need to create one? */
 526     if (PMC_IS_NULL(multisub)) {
 527         multisub = pmc_new(interp, enum_class_MultiSub);
 528         /* we have to push the sub onto the MultiSub before we try to store
 529         it because storing requires information from the sub */
 530         VTABLE_push_pmc(interp, multisub, sub);
 531         VTABLE_set_pmc_keyed_str(interp, ns, subname, multisub);
 532     }
 533     else
 534         VTABLE_push_pmc(interp, multisub, sub);
 535
 536     c_meth = string_to_cstring(interp, subname);
 537     if ((func_nr = Parrot_MMD_method_idx(interp, c_meth))  >= 0) {
 538         Parrot_mmd_rebuild_table(interp, -1, func_nr);
 539     }
 540     string_cstring_free(c_meth);
 541 }
 542
 543 void
 544 Parrot_store_sub_in_namespace(Parrot_Interp interp, PMC *sub)
 545 {
 546     INTVAL cur_id = CONTEXT(interp->ctx)->current_HLL;
 547     PMC *ns;
 548     /* PF structures aren't fully constructed yet */
 549     Parrot_block_DOD(interp);
 550     /* store relative to HLL namespace */
 551     CONTEXT(interp->ctx)->current_HLL = PMC_sub(sub)->HLL_id;
 552
 553     ns = get_namespace_pmc(interp, sub);
 554
 555     /* attach a namespace to the sub for lookups */
 556     PMC_sub(sub)->namespace_stash = ns;
 557
 558     /* store a :multi sub */
 559     if (!PMC_IS_NULL(PMC_sub(sub)->multi_signature))
 560         store_sub_in_multi(interp, sub, ns);
 561     /* store other subs (as long as they're not :anon) */
 562     else if (!(PObj_get_FLAGS(sub) & SUB_FLAG_PF_ANON)) {
 563         STRING *name   = PMC_sub(sub)->name;
 564         PMC    *nsname = PMC_sub(sub)->namespace_name;
 565
 566         Parrot_store_global_n(interp, ns, name, sub);
 567
 568         /* TEMPORARY HACK - cache invalidation should be a namespace function */
 569         if (!PMC_IS_NULL(nsname))
 570         {
 571             STRING *nsname_s = VTABLE_get_string(interp, nsname);
 572             Parrot_invalidate_method_cache(interp, nsname_s, name);
 573         }
 574     }
 575
 576     /* restore HLL_id */
 577     CONTEXT(interp->ctx)->current_HLL = cur_id;
 578     Parrot_unblock_DOD(interp);
 579 }
 580 /*
 581
 582 =back
 583
 584 =head1 SEE ALSO
 585
 586 F<include/parrot/global.h>
 587
 588 =cut
 589
 590 */
 591
 592
 593 /*
 594  * Local variables:
 595  *   c-file-style: "parrot"
 596  * End:
 597  * vim: expandtab shiftwidth=4:
 598  */