src/pmc/parrotinterpreter.pmc

   1 /*
   2 Copyright (C) 2001-2008, The Perl Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 src/pmc/parrotinterpreter.pmc - Parrot Interpreter
   8
   9 =head1 DESCRIPTION
  10
  11 These are the vtable functions for the ParrotInterpreter base class
  12
  13    getinterp P0
  14    set P1, P0[.IGLOBALS_*]  # access interpreter globals
  15    set I0, P0[x]            # interpinfo I0, x
  16    set I0, P0[-1]           # get interpreter flags
  17    set P0[-1], x            # set flags on interpreter
  18                             # NOTE: this doesn't restart
  19
  20 =head2 Functions
  21
  22 =over 4
  23
  24 =cut
  25
  26 */
  27
  28 #include "parrot/parrot.h"
  29 #include "parrot/embed.h"
  30 #include "parrot/dynext.h"
  31 #include "pmc_class.h"
  32
  33 /*
  34
  35 =item C<void
  36 clone_interpreter(Parrot_Interp dest, const Parrot_Interp source, INTVAL flags)>
  37
  38 Clones the interpreter as specified by the flags.
  39
  40 =cut
  41
  42 */
  43
  44 void
  45 clone_interpreter(Parrot_Interp d, Parrot_Interp s, INTVAL flags)
  46 {
  47     /* we block DOD runs while cloning since C<d> is not yet running */
  48     Parrot_block_DOD(d);
  49
  50     d->scheduler = pmc_new(d, enum_class_Scheduler);
  51     d->scheduler = VTABLE_share_ro(d, d->scheduler);
  52
  53     if (flags & PARROT_CLONE_RUNOPS)
  54         d->run_core = s->run_core;
  55
  56     if (flags & PARROT_CLONE_INTERP_FLAGS) {
  57         /* XXX setting of IS_THREAD? */
  58         d->flags       = s->flags;
  59         d->debug_flags = s->debug_flags;
  60     }
  61
  62     if (flags & PARROT_CLONE_HLL) {
  63         /* we'd like to share the HLL data. Give it a PMC_sync structure
  64            if it doesn't have one already */
  65         add_pmc_sync(s, s->HLL_info);
  66         d->HLL_info = s->HLL_info;
  67         Parrot_regenerate_HLL_namespaces(d);
  68     }
  69
  70     if (flags & (PARROT_CLONE_LIBRARIES | PARROT_CLONE_CLASSES)) {
  71         INTVAL i, last_remove;
  72         const INTVAL start = d->n_vtable_max;
  73
  74         /* copy type registrations to keep type numbers the same */
  75         d->class_hash   = Parrot_clone(d, s->class_hash);
  76         d->n_vtable_max = s->n_vtable_max;
  77
  78         if (d->n_vtable_max > d->n_vtable_alloced)
  79             parrot_realloc_vtables(d);
  80
  81         last_remove = s->n_vtable_max;
  82
  83         for (i = s->n_vtable_max - 1; i >= start; --i) {
  84             if (s->vtables[i] && s->vtables[i]->pmc_class &&
  85                 PObj_is_class_TEST(s->vtables[i]->pmc_class)) {
  86                 STRING * const class_name =
  87                     VTABLE_get_string(s, s->vtables[i]->pmc_class);
  88                 PARROT_ASSERT(VTABLE_exists_keyed_str(d,
  89                     d->class_hash, class_name));
  90
  91                 VTABLE_delete_keyed_str(d, d->class_hash, class_name);
  92
  93                 if (last_remove == i + 1) {
  94                     --d->n_vtable_max;
  95                     last_remove = i;
  96                 }
  97             }
  98         }
  99     }
 100
 101     if (flags & PARROT_CLONE_LIBRARIES) {
 102         PMC   * const libs     = VTABLE_get_pmc_keyed_int(s, s->iglobals,
 103             IGLOBALS_DYN_LIBS);
 104         PMC   * const lib_iter = VTABLE_get_iter(s, libs);
 105         const INTVAL n         = VTABLE_elements(s, libs);
 106         INTVAL i;
 107
 108         for (i = 0; i < n; ++i) {
 109             STRING * const key     = VTABLE_shift_string(s, lib_iter);
 110             PMC    * const lib_pmc = VTABLE_get_pmc_keyed_str(s, libs, key);
 111             PMC    * const ignored = Parrot_clone_lib_into(d, s, lib_pmc);
 112             UNUSED(ignored);
 113         }
 114     }
 115
 116     if (flags & PARROT_CLONE_CLASSES) {
 117         INTVAL i;
 118         for (i = 0; i < s->n_vtable_max; ++i) {
 119             if (s->vtables[i] && s->vtables[i]->pmc_class &&
 120                     PObj_is_class_TEST(s->vtables[i]->pmc_class)) {
 121                 /* Cloning the class into the new interpreter ought
 122                  * to be sufficient to instantiate the class.  */
 123                  PMC          *source       = s->vtables[i]->pmc_class;
 124                  PMC          *dest         = Parrot_clone(d, source);
 125                  Parrot_Class *source_class = PARROT_CLASS(source);
 126                  Parrot_Class *dest_class   = PARROT_CLASS(dest);
 127                  dest_class->name           = string_copy(d, source_class->name);
 128                  dest_class->_namespace     = VTABLE_clone(d, source_class->_namespace);
 129             }
 130         }
 131     }
 132
 133     if (flags & PARROT_CLONE_CODE)
 134         pt_clone_code(d, s);
 135
 136     if (flags & PARROT_CLONE_GLOBALS)
 137         pt_clone_globals(d, s);
 138
 139     Parrot_unblock_DOD(d);
 140 }
 141
 142
 143 /*
 144
 145 =item C<static void
 146 create_interp(PMC *self, Parrot_Interp parent)>
 147
 148 Creates a new child interpreter of C<parent>.
 149
 150 =cut
 151
 152 */
 153
 154 static void
 155 create_interp(PMC *self, Parrot_Interp parent)
 156 {
 157     Interp_flags flag  = PARROT_NO_FLAGS;
 158     Parrot_Interp new_interp;
 159
 160     if (self->vtable->base_type == enum_class_ParrotThread)
 161         flag = PARROT_IS_THREAD;
 162
 163     new_interp     = make_interpreter(parent, flag);
 164     PMC_data(self) = new_interp;
 165
 166     VTABLE_set_pmc_keyed_int(new_interp, new_interp->iglobals,
 167         (INTVAL) IGLOBALS_INTERPRETER, self);
 168
 169     new_interp->current_cont = NEED_CONTINUATION;
 170 }
 171
 172 static int
 173 recursion_limit(Parrot_Interp interp, PMC *self, int l)
 174 {
 175     const int ret           = interp->recursion_limit;
 176     interp->recursion_limit = l;
 177     return ret;
 178 }
 179
 180 pmclass ParrotInterpreter need_ext no_ro {
 181
 182 /*
 183
 184 =back
 185
 186 =head2 Methods
 187
 188 =over 4
 189
 190 =item C<void class_init()>
 191
 192 Class initialization.
 193
 194 =cut
 195
 196 */
 197
 198     void class_init() {
 199         const int typ = enum_class_ParrotInterpreter;
 200
 201         if (pass) {
 202             /* TODO unify and fix signatures */
 203             register_nci_method(INTERP, typ,
 204                     F2DPTR(pt_thread_yield), "yield", "v");
 205
 206             /* misc functions */
 207             register_nci_method(INTERP, typ,
 208                     F2DPTR(recursion_limit), "recursion_limit", "iJOi");
 209         }
 210     }
 211
 212 /*
 213
 214 =item C<void init()>
 215
 216 Initializes the interpreter.
 217
 218 =cut
 219
 220 */
 221
 222     VTABLE void init() {
 223         /*
 224          * init/init_pmc may be called internally (from thread creation in
 225          * ParrotThread::init_pmc() or stand-alone
 226          * so we check, if the interpreter is already setup
 227          */
 228         if (!PMC_data(SELF)) {
 229             create_interp(SELF, INTERP);
 230             PARROT_ASSERT(PMC_data(SELF));
 231         }
 232
 233         PMC_struct_val(SELF) = NULL;
 234         PMC_pmc_val(SELF)    = NULL;
 235     }
 236
 237 /*
 238
 239 =item C<void init_pmc(PMC *parent)>
 240
 241 Initializes a child interpreter with C<*parent> if C<parent> is
 242 a ParrotInterpreter instance. Otherwise takes the thread ID from
 243 C<parent> and uses that thread.
 244
 245 =cut
 246
 247 */
 248
 249     VTABLE void init_pmc(PMC *parent) {
 250         Parrot_Interp p = PMC_data_typed(parent, Parrot_Interp);
 251
 252         if (!PMC_data(SELF))
 253             create_interp(SELF, p);
 254
 255         PMC_struct_val(SELF) = NULL;
 256     }
 257
 258 /*
 259
 260 =item C<void set_pointer(void *value)>
 261
 262 Sets C<struct_val> to C<*value>.
 263
 264 =cut
 265
 266 */
 267
 268     VTABLE void set_pointer(void *value) {
 269         PMC_struct_val(SELF) = value;
 270     }
 271
 272 /*
 273
 274 =item C<void *get_pointer()>
 275
 276 Returns C<struct_val>.
 277
 278 =cut
 279
 280 */
 281
 282     VTABLE void *get_pointer() {
 283         return PMC_struct_val(SELF);
 284     }
 285
 286 /*
 287
 288 =item C<INTVAL get_integer()>
 289
 290 Returns the thread id of the interpreter.
 291
 292 =cut
 293
 294 */
 295
 296     VTABLE INTVAL get_integer() {
 297         const Parrot_Interp i = PMC_data_typed(SELF, Parrot_Interp);
 298         return (INTVAL)i->thread_data->tid;
 299     }
 300
 301 /*
 302
 303 =item C<opcode_t *invoke(void *next)>
 304
 305 Runs the interpreter's byte code.
 306
 307 =cut
 308
 309 */
 310
 311     VTABLE opcode_t *invoke(void *next) {
 312         Interp * const new_interp = PMC_data_typed(SELF, Interp *);
 313
 314         /* setup code */
 315         pt_thread_prepare_for_run(new_interp, interp);
 316
 317         /* TODO pass arguments from parent (interp) to child (new_interp) by
 318          * possibly clone of share the arguments r/o args can be passed as is */
 319
 320         /* calculate offset and run */
 321         runops(new_interp, (opcode_t *)PMC_struct_val(SELF) -
 322             (opcode_t *)interp->code->base.data);
 323
 324         return (opcode_t *)next;
 325     }
 326
 327 /*
 328
 329 =item C<PMC *get_pmc_keyed_int(INTVAL key)>
 330
 331 Returns the PMC global value for C<key>.
 332
 333 =cut
 334
 335 */
 336
 337     VTABLE PMC *get_pmc_keyed_int(INTVAL key) {
 338         Interp * const new_interp = PMC_data_typed(SELF, Interp *);
 339
 340         if (key >= 0 && key < IGLOBALS_SIZE)
 341             return VTABLE_get_pmc_keyed_int(new_interp,
 342                 new_interp->iglobals, key);
 343
 344         /* quick hack to get the global stash */
 345         if (key == -1)
 346             return new_interp->root_namespace;
 347
 348         return PMCNULL;
 349     }
 350
 351 /*
 352
 353 =item C<PMC *get_pmc_keyed(PMC *key)>
 354
 355 Introspection interface. C<key> can be:
 356
 357   "sub"                     ... return Sub object of this subroutine
 358   "continuation"            ... return Continuation PMC
 359   "lexpad"                  ... return lexpad PMC for this sub
 360   "namespace"               ... return namespace PMC for this sub
 361   "outer"                   ... return outer sub of this closure
 362   "<item>"; level           ... same for caller <level>
 363   "outer"; "<item>"         ... same for outer level 1
 364   "outer"; "<item>"; level  ... same for outer <level>
 365   "globals"                 ... return global stash
 366
 367 =cut
 368
 369 */
 370
 371     VTABLE PMC *get_pmc_keyed(PMC *key) {
 372         PMC    *nextkey, *cont;
 373         STRING *outer = NULL;
 374         STRING *item  = key_string(interp, key);
 375         STRING *s     = CONST_STRING(interp, "globals");
 376         int     level = 0;
 377
 378         parrot_context_t *ctx;
 379
 380         if (string_equal(interp, item, s) == 0)
 381             return interp->root_namespace;
 382
 383         s     = CONST_STRING(interp, "outer");
 384
 385         if (string_equal(interp, item, s) == 0) {
 386             outer   = item;
 387             nextkey = key_next(INTERP, key);
 388
 389             if (nextkey && (PObj_get_FLAGS(nextkey) & KEY_string_FLAG)) {
 390                 key  = nextkey;
 391                 item = key_string(interp, key);
 392             }
 393         }
 394
 395         nextkey = key_next(INTERP, key);
 396
 397         if (nextkey)
 398             level = key_integer(interp, nextkey);
 399         else if (outer)
 400             level = 1;
 401
 402         if (level < 0)
 403             real_exception(interp, NULL, E_ValueError, "No such caller depth");
 404
 405         ctx = CONTEXT(interp);
 406
 407         if (outer) {
 408             for (; level; --level) {
 409                 ctx = ctx->outer_ctx;
 410                 if (!ctx)
 411                     real_exception(interp, NULL, E_ValueError,
 412                             "No such outer depth");
 413             }
 414         }
 415         else {
 416             for (; level; --level) {
 417                 cont = ctx->current_cont;
 418
 419                 if (PMC_IS_NULL(cont) || !PMC_cont(cont)->seg)
 420                     real_exception(interp, NULL, E_ValueError,
 421                             "No such caller depth");
 422
 423                 ctx = PMC_cont(cont)->to_ctx;
 424
 425                 if (!ctx->current_sub)
 426                     real_exception(interp, NULL, E_ValueError,
 427                             "No such caller depth");
 428             }
 429         }
 430
 431         if (item == outer)
 432             return ctx->current_sub;
 433
 434         s = CONST_STRING(interp, "sub");
 435
 436         if (string_equal(interp, item, s) == 0)
 437             return ctx->current_sub;
 438
 439         s = CONST_STRING(interp, "lexpad");
 440
 441         if (string_equal(interp, item, s) == 0)
 442             return ctx->lex_pad;
 443
 444         s = CONST_STRING(interp, "namespace");
 445
 446         if (string_equal(interp, item, s) == 0)
 447             return ctx->current_namespace;
 448
 449         s = CONST_STRING(interp, "continuation");
 450
 451         if (string_equal(interp, item, s) == 0)
 452             return VTABLE_clone(interp, ctx->current_cont);
 453
 454         real_exception(interp, NULL, E_ValueError,
 455                 "No such item %Ss", item);
 456     }
 457
 458 /*
 459
 460 =item C<INTVAL get_integer_keyed_int(INTVAL key)>
 461
 462 Returns the interpreter info for C<key>.
 463
 464 =cut
 465
 466 */
 467
 468     VTABLE INTVAL get_integer_keyed_int(INTVAL key) {
 469         Interp * const new_interp = PMC_data_typed(SELF, Interp *);
 470
 471         if (key == -1)
 472             return (INTVAL)new_interp->flags;
 473
 474         return interpinfo(new_interp, key);
 475     }
 476
 477 /*
 478
 479 =item C<void set_integer_keyed_int(INTVAL key, INTVAL val)>
 480
 481 Sets the interpreter info for C<key> to C<val>.
 482
 483 =cut
 484
 485 */
 486
 487     VTABLE void set_integer_keyed_int(INTVAL key, INTVAL val) {
 488         Interp * const new_interp = PMC_data_typed(SELF, Interp *);
 489
 490         /* set interpreter flags */
 491         if (key == -1) {
 492             const INTVAL allowed = PARROT_BOUNDS_FLAG | PARROT_PROFILE_FLAG |
 493                              PARROT_GC_DEBUG_FLAG;
 494             Parrot_clear_flag(new_interp, allowed);
 495             Parrot_set_flag(new_interp, val & allowed);
 496         }
 497     }
 498
 499 /*
 500
 501 =item C<PMC *clone()>
 502
 503 First attempt to make things running, and to see, where problems may
 504 arise. Only minimal items are done yet.
 505
 506 XXX this should of course call C<Parrot_clone()> and use freeze/thaw.
 507
 508 =cut
 509
 510 */
 511
 512     VTABLE PMC *clone() {
 513         PMC * const dest = pmc_new(INTERP, SELF->vtable->base_type);
 514
 515         clone_interpreter((Parrot_Interp)PMC_data(dest),
 516                           (Parrot_Interp)PMC_data(SELF), PARROT_CLONE_DEFAULT);
 517
 518         return dest;
 519     }
 520
 521 /*
 522
 523 =item C<INTVAL is_equal(PMC *val)>
 524
 525 Returns whether the interpreter is equal to C<*val>.
 526
 527 Two interpreters (threads) are equal if both are non-threaded or they
 528 have the same thread id.
 529
 530 =cut
 531
 532 */
 533
 534     VTABLE INTVAL is_equal(PMC *val) {
 535         Parrot_Interp self  = PMC_data_typed(SELF, Parrot_Interp);
 536         Parrot_Interp other = PMC_data_typed(val, Parrot_Interp);
 537
 538         if (!self->thread_data && !other->thread_data)
 539             return 1;
 540
 541         if (self->thread_data && other->thread_data &&
 542             self->thread_data->tid == other->thread_data->tid)
 543             return 1;
 544
 545         return 0;
 546     }
 547
 548 /*
 549
 550 =item C<void visit(visit_info *info)>
 551
 552 This is used by freeze/thaw to visit the contents of the interpreter.
 553
 554 C<*info> is the visit info, (see F<include/parrot/pmc_freeze.h>).
 555
 556 =item C<void freeze(visit_info *info)>
 557
 558 Used to archive the interpreter. Actually not the whole interpreter is
 559 frozen but the state of the interpreter, which includes everything that
 560 has changes since creating an empty interpreter.
 561
 562 =item C<void thaw(visit_info *info)>
 563
 564 Used to unarchive the interpreter. This merges the changes into this
 565 interpreter instance.
 566
 567 =item C<void thawfinish(visit_info *info)>
 568
 569 Finish thawing.
 570
 571 =cut
 572
 573 */
 574
 575     VTABLE void visit(visit_info *info) {
 576         PMC **pos;
 577         /*
 578          * the information frozen here is part of all PBCs
 579          * we probably need to freeze all dynamic extensible
 580          * mappings (or at least the dynamic part)
 581          * e.g.
 582          *    charsets   idx - name
 583          *    encodings  idx - name
 584          *    pmc types  idx - name
 585          *    dynamic oplibs    opcode nr - opname
 586          *
 587          * The machine thawing this info still needs to load
 588          * these extensions, but the order of loading could be
 589          * relaxed.
 590          *
 591          * creating all these info as standard PMCs would vastly
 592          * simplify this process
 593          *
 594          * thaw would then need a merge operation:
 595          *  - compare existing for sanity
 596          *  - extend new
 597          */
 598
 599         /*  HLL_info */
 600         if (info->what == VISIT_THAW_NORMAL ||
 601                 info->what == VISIT_THAW_CONSTANTS) {
 602             pos = &PMC_pmc_val(SELF);
 603         }
 604         else
 605             pos = &INTERP->HLL_info;
 606
 607         info->thaw_ptr = pos;
 608         (info->visit_pmc_now)(INTERP, *pos, info);
 609     }
 610
 611     VTABLE void thaw(visit_info *info) {
 612         if (info->extra_flags == EXTRA_IS_PROP_HASH) {
 613             SUPER(info);
 614         }
 615         else if (info->extra_flags == EXTRA_IS_NULL) {
 616             PMC_data(SELF) = INTERP;
 617             info->what     = VISIT_THAW_CONSTANTS;
 618         }
 619     }
 620
 621     void thawfinish(visit_info *info) {
 622         PMC * const new_info = PMC_pmc_val(SELF);
 623         const INTVAL  m      = VTABLE_elements(INTERP, new_info);
 624         INTVAL  i;
 625
 626         PMC_pmc_val(SELF) = NULL;
 627
 628         /* merge new_info */
 629         /* TODO compare old entries */
 630
 631         for (i = 0; i < m; ++i) {
 632             PMC * const entry    = VTABLE_get_pmc_keyed_int(INTERP, new_info, i);
 633             PMC * const lib_pmc  = VTABLE_get_pmc_keyed_int(INTERP, entry, e_HLL_lib);
 634             PMC * const name_pmc = VTABLE_get_pmc_keyed_int(INTERP, entry, e_HLL_name);
 635             PMC * const typemap  = VTABLE_get_pmc_keyed_int(INTERP, entry, e_HLL_typemap);
 636             INTVAL hll_id = - 1;
 637
 638             if (!PMC_IS_NULL(name_pmc)) {
 639                 STRING * const hll_name = VTABLE_get_string(INTERP, name_pmc);
 640
 641                 hll_id           = Parrot_register_HLL(INTERP, hll_name);
 642             }
 643
 644             if (!PMC_IS_NULL(lib_pmc)) {
 645                 STRING *lib_name = VTABLE_get_string(INTERP, lib_pmc);
 646                 PMC    *ignored;
 647
 648                 if (!STRING_IS_EMPTY(lib_name)) {
 649                     INTVAL id;
 650                     ignored      = Parrot_load_lib(INTERP, lib_name, NULL);
 651                     id           = Parrot_register_HLL_lib(INTERP, lib_name);
 652                     UNUSED(id);
 653                 }
 654
 655                 UNUSED(ignored);
 656             }
 657
 658             if (hll_id >= 0 && !PMC_IS_NULL(typemap)) {
 659                 PMC   *iter = VTABLE_get_iter(INTERP, typemap);
 660                 INTVAL e    = VTABLE_get_integer(INTERP, typemap);
 661                 INTVAL i;
 662
 663                 for (i = 0; i < e; ++i) {
 664                     PMC * const key        = VTABLE_shift_pmc(INTERP, iter);
 665                     const INTVAL core_type = VTABLE_get_integer(INTERP, key);
 666                     const INTVAL hll_type  =
 667                         VTABLE_get_integer_keyed_int(INTERP, typemap, core_type);
 668
 669                     Parrot_register_HLL_type(INTERP, hll_id,
 670                         core_type, hll_type);
 671                 }
 672             }
 673         }
 674     }
 675
 676     METHOD run_gc() {
 677         Parrot_do_dod_run(PMC_data_typed(SELF, Parrot_Interp), 0);
 678     }
 679 }
 680
 681 /*
 682
 683 =back
 684
 685 =cut
 686
 687 */
 688
 689 /*
 690  * Local variables:
 691  *   c-file-style: "parrot"
 692  * End:
 693  * vim: expandtab shiftwidth=4:
 694  */