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_global(Interp *, PMC *ns, STRING *globalname)>
 162
 163 Look up the global named C<globalname> in the namespace C<ns>.  Return the
 164 global, or return PMCNULL if C<ns> is null or if the global is not found.
 165
 166 KLUDGE ALERT: Currently prefers non-namespaces in case of collision.
 167
 168 =item C<PMC *
 169 Parrot_set_global(Interp *, PMC *ns, STRING *globalname, PMC *val)>
 170
 171 Set the global named C<globalname> in the namespace C<ns> to the value C<val>.
 172
 173 =cut
 174
 175 */
 176
 177 PMC *
 178 Parrot_get_global(Interp *interp, PMC *ns, STRING *globalname)
 179 {
 180     if (PMC_IS_NULL(ns))
 181         return PMCNULL;
 182
 183     return VTABLE_get_pointer_keyed_str(interp, ns, globalname);
 184 }
 185
 186 void
 187 Parrot_set_global(Interp *interp, PMC *ns, STRING *globalname, PMC *val)
 188 {
 189     VTABLE_set_pmc_keyed_str(interp, ns, globalname, val);
 190 }
 191
 192
 193 /*
 194
 195 =item C<PMC *
 196 Parrot_find_global_n(Interp *, PMC *ns, STRING *globalname)>
 197
 198 Search the namespace PMC C<ns> for an object with name C<globalname>.
 199 Return the object, or NULL if not found.
 200
 201 XXX - For now this function prefers non-namespaces, it will eventually
 202 entirely use the untyped interface.
 203
 204 =item C<PMC *
 205 Parrot_find_global_k(Interp *, PMC *pmc_key, STRING *globalname)>
 206
 207 Search the namespace designated by C<pmc_key>, which may be a key PMC,
 208 an array of namespace name strings, or a string PMC, for an object
 209 with name C<globalname>.  Return the object, or NULL if not found.
 210
 211 XXX - For now this function prefers non-namespaces, it will eventually
 212 entirely use the untyped interface.
 213
 214 =item C<PMC *
 215 Parrot_find_global_s(Interp *, STRING *str_key, STRING *globalname)>
 216
 217 Search the namespace designated by C<str_key>, or the HLL root if
 218 C<str_key> is NULL, for an object with name C<globalname>.  Return the
 219 object, or NULL if not found.
 220
 221 XXX - For now this function prefers non-namespaces, it will eventually
 222 entirely use the untyped interface.
 223
 224 =cut
 225
 226 */
 227
 228 PMC *
 229 Parrot_find_global_n(Interp *interpreter, PMC *ns, STRING *globalname)
 230 {
 231     PMC *res;
 232
 233 #if DEBUG_GLOBAL
 234     if (globalname)
 235         PIO_printf(interpreter, "find_global name '%Ss'\n", globalname);
 236 #endif
 237
 238     if (PMC_IS_NULL(ns))
 239         res = PMCNULL;
 240     else {
 241         /*
 242          * XXX - we should be able to use 'get_pmc_keyed' here,
 243          * but we can't because Parrot's default namespaces are not
 244          * fully typed and there's a pseudo-typed interface that
 245          * distinguishes 'get_pmc_keyed' from 'get_pointer_keyed';
 246          * the former is for NS and the latter is for non-NS.
 247          */
 248         res = VTABLE_get_pointer_keyed_str(interpreter, ns, globalname);
 249     }
 250
 251     return PMC_IS_NULL(res) ? NULL : res;
 252 }
 253
 254 PMC *
 255 Parrot_find_global_cur(Interp *interpreter, STRING *globalname)
 256 {
 257     PMC * const ns = CONTEXT(interpreter->ctx)->current_namespace;
 258     return Parrot_find_global_n(interpreter, ns, globalname);
 259 }
 260
 261 PMC *
 262 Parrot_find_global_k(Interp *interpreter, PMC *pmc_key, STRING *globalname)
 263 {
 264     PMC * const ns =
 265         Parrot_get_namespace_keyed(interpreter,
 266                                    Parrot_get_ctx_HLL_namespace(interpreter),
 267                                    pmc_key);
 268     return Parrot_find_global_n(interpreter, ns, globalname);
 269 }
 270
 271 PMC *
 272 Parrot_find_global_s(Interp *inter, STRING *str_key, STRING *globalname)
 273 {
 274     PMC *const ns =
 275         Parrot_get_namespace_keyed_str(inter,
 276                                        Parrot_get_ctx_HLL_namespace(inter),
 277                                        str_key);
 278     return Parrot_find_global_n(inter, ns, globalname);
 279 }
 280
 281 /*
 282
 283 =item C<PMC *
 284 Parrot_store_global_n(Interp *, PMC *ns, STRING *globalname, PMC *val)>
 285
 286 Store the PMC C<val> into the namespace PMC C<ns> with name C<globalname>.
 287
 288 =item C<PMC *
 289 Parrot_store_global_k(Interp *, PMC *pmc_key, STRING *globalname, PMC *val)>
 290
 291 Store the PMC C<val> into the namespace designated by C<pmc_key>,
 292 which may be a key PMC, an array of namespace name strings, or a
 293 string PMC, with name C<globalname>.
 294
 295 XXX - For now this function prefers non-namespaces, it will eventually
 296 entirely use the untyped interface.
 297
 298 =item C<PMC *
 299 Parrot_store_global_s(Interp *, STRING *str_key, STRING *globalname, PMC *val)>
 300
 301 Store the PMC C<val> into the namespace designated by C<str_key>, or
 302 the HLL root if C<str_key> is NULL, with the name C<globalname>.
 303
 304 =cut
 305
 306 */
 307
 308 void
 309 Parrot_store_global_n(Interp *interpreter, PMC *ns,
 310                       STRING *globalname, PMC *val)
 311 {
 312 #if DEBUG_GLOBAL
 313     if (globalname)
 314         PIO_printf(interpreter, "store_global name '%Ss'\n", globalname);
 315 #endif
 316
 317     if (PMC_IS_NULL(ns))
 318         return;
 319
 320     VTABLE_set_pmc_keyed_str(interpreter, ns, globalname, val);
 321 }
 322
 323 void
 324 Parrot_store_global_cur(Interp *interpreter, STRING *globalname, PMC *val)
 325 {
 326     Parrot_store_global_n(interpreter,
 327                           CONTEXT(interpreter->ctx)->current_namespace,
 328                           globalname, val);
 329
 330     /* FIXME - method cache invalidation should occur */
 331 }
 332
 333 void
 334 Parrot_store_global_k(Interp *interpreter, PMC *pmc_key,
 335                       STRING *globalname, PMC *val)
 336 {
 337     PMC *ns;
 338
 339     /*
 340      * XXX - temporary hack to notice when key is actually a string, so that
 341      * the legacy logic for invalidating method cache will be called; this is
 342      * not good enough but it avoids regressesions for now
 343      */
 344     if (pmc_key->vtable->base_type == enum_class_String) {
 345         Parrot_store_global_s(interpreter, PMC_str_val(pmc_key),
 346                               globalname, val);
 347         return;
 348     }
 349
 350     ns = Parrot_make_namespace_keyed(interpreter,
 351                                      Parrot_get_ctx_HLL_namespace(interpreter),
 352                                      pmc_key);
 353
 354     Parrot_store_global_n(interpreter, ns, globalname, val);
 355
 356     /* FIXME - method cache invalidation should occur */
 357 }
 358
 359 void
 360 Parrot_store_global_s(Interp *inter, STRING *str_key,
 361                       STRING *globalname, PMC *val)
 362 {
 363     PMC *ns;
 364
 365     ns = Parrot_make_namespace_keyed_str(inter,
 366                                          Parrot_get_ctx_HLL_namespace(inter),
 367                                          str_key);
 368
 369     Parrot_store_global_n(inter, ns, globalname, val);
 370
 371     /* FIXME - method cache invalidation should be a namespace function */
 372     Parrot_invalidate_method_cache(inter, str_key, globalname);
 373 }
 374
 375
 376 /*
 377
 378 =item C<PMC *
 379 Parrot_find_global_op(Interp *, PMC *ns, STRING *globalname, void *next)>
 380
 381 If the global exists in the given namespace PMC, return it.  If not, return
 382 PMCNULL.
 383
 384 =cut
 385
 386 */
 387
 388 PMC *
 389 Parrot_find_global_op(Interp *interpreter, PMC *ns,
 390                       STRING *globalname, void *next)
 391 {
 392     PMC *res;
 393
 394     if (!globalname)
 395         real_exception(interpreter, next, E_NameError,
 396                        "Tried to get null global");
 397
 398     res = Parrot_find_global_n(interpreter, ns, globalname);
 399     if (!res)
 400         res = PMCNULL;
 401
 402     return res;
 403 }
 404
 405
 406 /*
 407
 408 =item C<PMC *
 409 Parrot_find_name_op(Interp *, STRING *name, void *next)>
 410
 411 TODO - THIS IS BROKEN - it doesn't walk up the scopes yet - TODO
 412
 413 Find the given C<name> in lexicals, then the current namespace, then the HLL
 414 root namespace, and finally Parrot builtins.  If the name isn't found
 415 anywhere, return PMCNULL.
 416
 417 =cut
 418
 419 */
 420
 421 PMC *
 422 Parrot_find_name_op(Interp *interpreter, STRING *name, void *next)
 423 {
 424     parrot_context_t * const ctx = CONTEXT(interpreter->ctx);
 425     PMC *g, *lex_pad;
 426
 427     g = PMCNULL;
 428
 429     lex_pad = Parrot_find_pad(interpreter, name, ctx);
 430     if (!PMC_IS_NULL(lex_pad))
 431         g = VTABLE_get_pmc_keyed_str(interpreter, lex_pad, name);
 432
 433     /* TODO TODO TODO - walk up the scopes!  duh!! */
 434
 435     if (PMC_IS_NULL(g))
 436         g = Parrot_find_global_cur(interpreter, name);
 437
 438     if (PMC_IS_NULL(g))
 439         g = Parrot_find_global_n(interpreter,
 440                                  Parrot_get_ctx_HLL_namespace(interpreter),
 441                                  name);
 442
 443     if (PMC_IS_NULL(g))
 444         g = Parrot_find_builtin(interpreter, name);
 445
 446     if (! PMC_IS_NULL(g)) {
 447         if (g->vtable->base_type == enum_class_MultiSub &&
 448                 interpreter->current_args) {
 449             /*
 450              * inside a function call, we have an args signature
 451              */
 452             g = Parrot_MMD_search_default_func(interpreter, name);
 453             if (! PMC_IS_NULL(g))
 454                 return g;
 455         }
 456         else
 457             return g;
 458     }
 459
 460     return PMCNULL;
 461 }
 462
 463
 464 /*
 465  * store a subroutine
 466  *
 467  * FIXME - This should not be here!
 468  * It's generic logic that should apply whenever a Sub is stored anywhere,
 469  *  and since lots of things can be invoked, maybe more than just Subs.
 470  * Where it _should_ be, I don't know for sure.
 471  *
 472  * if pmc_key is provided, it wins.
 473  * else if str_key is provided, it is used.
 474  * if neither is provided, the HLL namespace is used.
 475  */
 476
 477 static void
 478 store_sub(Interp *interpreter, PMC *pmc_key, STRING *str_key,
 479           STRING *sub_name, PMC *sub_pmc)
 480 {
 481     int hll_id;
 482     PMC *ns;
 483
 484     if (sub_pmc->vtable->base_type == enum_class_MultiSub) {
 485         PMC *one_sub;
 486
 487         one_sub = VTABLE_get_pmc_keyed_int(interpreter, sub_pmc, 0);
 488         hll_id = PMC_sub(one_sub)->HLL_id;
 489     }
 490     else
 491         hll_id = PMC_sub(sub_pmc)->HLL_id;
 492
 493     ns = Parrot_get_HLL_namespace(interpreter, hll_id);
 494     if (!PMC_IS_NULL(pmc_key))
 495         ns = Parrot_make_namespace_keyed(interpreter, ns, pmc_key);
 496     else if (str_key)
 497         ns = Parrot_make_namespace_keyed_str(interpreter, ns, str_key);
 498
 499     Parrot_store_global_n(interpreter, ns, sub_name, sub_pmc);
 500
 501     /* TEMPORARY HACK - cache invalidation should be a namespace function */
 502     if (! PMC_IS_NULL(pmc_key)) {
 503         if (pmc_key->vtable->base_type == enum_class_String)
 504             Parrot_invalidate_method_cache(interpreter,
 505                                            PMC_str_val(pmc_key), sub_name);
 506     }
 507     else if (str_key)
 508         Parrot_invalidate_method_cache(interpreter, str_key, sub_name);
 509
 510     /* MultiSub isa R*PMCArray and doesn't have a PMC_sub structure
 511      * MultiSub could also contain subs from various namespaces,
 512      * so it doesn't make much sense to associate a namespace
 513      * with a multi.
 514      */
 515     if (sub_pmc->vtable->base_type != enum_class_MultiSub)
 516         PMC_sub(sub_pmc)->namespace_stash = ns;
 517 }
 518
 519 static void
 520 store_sub_in_namespace(Parrot_Interp interpreter, PMC* sub_pmc,
 521                        PMC *pmc_key, STRING *sub_name)
 522 {
 523     /*
 524      * pmc_key is either a String, or a Key, or NULL
 525      */
 526     if (PMC_IS_NULL(pmc_key))
 527         store_sub(interpreter, PMCNULL, NULL, sub_name, sub_pmc);
 528     else {
 529         INTVAL type = pmc_key->vtable->base_type;
 530         switch (type) {
 531             case enum_class_String:
 532                 store_sub(interpreter, PMCNULL, PMC_str_val(pmc_key),
 533                           sub_name, sub_pmc);
 534                 break;
 535             case enum_class_Key:
 536                 store_sub(interpreter, pmc_key, NULL, sub_name, sub_pmc);
 537                 break;
 538             default:
 539                 internal_exception(1,
 540                                    "Namespace constant is neither "
 541                                    "String nor Key");
 542         }
 543     }
 544 }
 545
 546 /* XXX in mmd.c ? */
 547 STRING* Parrot_multi_long_name(Parrot_Interp interpreter, PMC* sub_pmc);
 548
 549 STRING*
 550 Parrot_multi_long_name(Parrot_Interp interpreter, PMC* sub_pmc)
 551 {
 552     PMC *multi_sig;
 553     STRING* sub_name, *sig;
 554     INTVAL i, n;
 555
 556     sub_name = PMC_sub(sub_pmc)->name;
 557     multi_sig = PMC_sub(sub_pmc)->multi_signature;
 558     n = VTABLE_elements(interpreter, multi_sig);
 559     /*
 560      * foo :multi(STRING, Integer) =>
 561      *
 562      * foo_@STRING_@Integer
 563      */
 564     for (i = 0; i < n; ++i) {
 565         sig = VTABLE_get_string_keyed_int(interpreter, multi_sig, i);
 566         sub_name = string_concat(interpreter, sub_name,
 567                 const_string(interpreter, "_@"), 0);
 568         sub_name = string_concat(interpreter, sub_name, sig, 0);
 569     }
 570     return sub_name;
 571 }
 572
 573 static void
 574 store_named_in_namespace(Parrot_Interp interpreter, PMC* sub_pmc)
 575 {
 576     STRING* sub_name;
 577     PMC *multi_sig;
 578     PMC *namespace;
 579     INTVAL func_nr;
 580     char *c_meth;
 581
 582     sub_name  = PMC_sub(sub_pmc)->name;
 583     namespace = PMC_sub(sub_pmc)->namespace;
 584     multi_sig = PMC_sub(sub_pmc)->multi_signature;
 585
 586     if (PMC_IS_NULL(multi_sig)) {
 587         store_sub_in_namespace(interpreter, sub_pmc, namespace, sub_name);
 588     }
 589     else {
 590         STRING *long_name;
 591         PMC *multi_sub;
 592         PMC *stash;
 593
 594         /* If namespace is NULL, we need to look in the root HLL namespace. But
 595            since we haven't actually run code yet, the context hasn't been set
 596            to include the HLL, so we have to do the work ourselves. */
 597         stash = Parrot_get_HLL_namespace(interpreter, PMC_sub(sub_pmc)->HLL_id);
 598         if (! PMC_IS_NULL(namespace))
 599             stash = VTABLE_get_pmc_keyed(interpreter, stash, namespace);
 600         multi_sub = PMC_IS_NULL(stash)
 601             ? PMCNULL
 602             : VTABLE_get_pmc_keyed_str(interpreter, stash, sub_name);
 603
 604         /* is there an existing MultiSub PMC? or do we need to create one? */
 605         if (PMC_IS_NULL(multi_sub)) {
 606             multi_sub = pmc_new(interpreter, enum_class_MultiSub);
 607             /* we have to push the sub onto the MultiSub before we try to store
 608                it because storing requires information from the sub */
 609             VTABLE_push_pmc(interpreter, multi_sub, sub_pmc);
 610             store_sub_in_namespace(interpreter, multi_sub,
 611                     namespace, sub_name);
 612         }
 613         else
 614             VTABLE_push_pmc(interpreter, multi_sub, sub_pmc);
 615
 616         long_name = Parrot_multi_long_name(interpreter, sub_pmc);
 617         store_sub_in_namespace(interpreter, sub_pmc, namespace, long_name);
 618
 619         c_meth = string_to_cstring(interpreter, sub_name);
 620         if ( (func_nr = Parrot_MMD_method_idx(interpreter, c_meth))  >= 0) {
 621             Parrot_mmd_rebuild_table(interpreter, -1, func_nr);
 622         }
 623         string_cstring_free(c_meth);
 624     }
 625 }
 626
 627 /* TODO - this looks like it doesn't understand nested namespaces */
 628
 629 void
 630 Parrot_store_sub_in_namespace(Parrot_Interp interpreter, PMC *sub)
 631 {
 632     if (!(PObj_get_FLAGS(sub) & SUB_FLAG_PF_ANON)) {
 633         INTVAL cur_id = CONTEXT(interpreter->ctx)->current_HLL;
 634         /* PF structures aren't fully constructed yet */
 635         Parrot_block_DOD(interpreter);
 636         /* store relative to HLL namespace */
 637         CONTEXT(interpreter->ctx)->current_HLL = PMC_sub(sub)->HLL_id;
 638
 639         store_named_in_namespace(interpreter, sub);
 640
 641         /* restore HLL_id */
 642         CONTEXT(interpreter->ctx)->current_HLL = cur_id;
 643         Parrot_unblock_DOD(interpreter);
 644     }
 645     else {
 646         PMC *stash =
 647             Parrot_get_HLL_namespace(interpreter, PMC_sub(sub)->HLL_id);
 648         PMC_sub(sub)->namespace_stash = stash;
 649     }
 650 }
 651 /*
 652
 653 =back
 654
 655 =head1 SEE ALSO
 656
 657 F<include/parrot/global.h>
 658
 659 =cut
 660
 661 */
 662
 663
 664 /*
 665  * Local variables:
 666  *   c-file-style: "parrot"
 667  * End:
 668  * vim: expandtab shiftwidth=4:
 669  */