src/pmc/parrotinterpreter.pmc

   1 /*
   2 Copyright (C) 2001-2010, Parrot 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/embed.h"
  29 #include "parrot/dynext.h"
  30 #include "parrot/io.h"
  31 #include "parrot/runcore_api.h"
  32 #include "pmc/pmc_class.h"
  33 #include "pmc/pmc_sub.h"
  34
  35 #define PMC_interp(x) ((Parrot_ParrotInterpreter_attributes *)PMC_data(x))->interp
  36 #define PMC_args(x)   ((Parrot_ParrotInterpreter_attributes *)PMC_data(x))->args
  37 #define PMC_sub(x)    ((Parrot_ParrotInterpreter_attributes *)PMC_data(x))->sub
  38
  39 /* HEADERIZER HFILE: none */
  40 /* HEADERIZER BEGIN: static */
  41 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
  42
  43 static void create_interp(
  44     ARGIN(PMC *self),
  45     ARGIN_NULLOK(Parrot_Interp parent))
  46         __attribute__nonnull__(1);
  47
  48 #define ASSERT_ARGS_create_interp __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
  49        PARROT_ASSERT_ARG(self))
  50 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
  51 /* HEADERIZER END: static */
  52
  53 /*
  54
  55 =item C<void clone_interpreter(Parrot_Interp d, Parrot_Interp s, INTVAL flags)>
  56
  57 Clones the interpreter as specified by the flags.
  58
  59 =cut
  60
  61 */
  62
  63 void
  64 clone_interpreter(Parrot_Interp d, Parrot_Interp s, INTVAL flags)
  65 {
  66     /* we block GC runs while cloning since C<d> is not yet running */
  67     Parrot_block_GC_mark(d);
  68
  69     d->scheduler = Parrot_pmc_new(d, enum_class_Scheduler);
  70     d->scheduler = VTABLE_share_ro(d, d->scheduler);
  71
  72     /* can't copy directly, unless you want double-frees */
  73     if (flags & PARROT_CLONE_RUNOPS)
  74         Parrot_runcore_switch(d, s->run_core->name);
  75
  76     if (flags & PARROT_CLONE_INTERP_FLAGS) {
  77         /* XXX setting of IS_THREAD? */
  78         d->flags       = s->flags;
  79         d->debug_flags = s->debug_flags;
  80     }
  81
  82     if (flags & PARROT_CLONE_HLL) {
  83         /* we'd like to share the HLL data. Give it a PMC_sync structure
  84            if it doesn't have one already */
  85         d->HLL_info = s->HLL_info;
  86         Parrot_regenerate_HLL_namespaces(d);
  87     }
  88
  89     if (flags & (PARROT_CLONE_LIBRARIES | PARROT_CLONE_CLASSES)) {
  90         INTVAL i, last_remove;
  91         const INTVAL start = d->n_vtable_max;
  92
  93         /* copy type registrations to keep type numbers the same */
  94         d->class_hash   = Parrot_clone(d, s->class_hash);
  95         d->n_vtable_max = s->n_vtable_max;
  96
  97         if (d->n_vtable_max > d->n_vtable_alloced)
  98             parrot_realloc_vtables(d);
  99
 100         last_remove = s->n_vtable_max;
 101
 102         for (i = s->n_vtable_max - 1; i >= start; --i) {
 103             if (s->vtables[i] && s->vtables[i]->pmc_class &&
 104                 PObj_is_class_TEST(s->vtables[i]->pmc_class)) {
 105                 STRING * const class_name =
 106                     VTABLE_get_string(s, s->vtables[i]->pmc_class);
 107                 PARROT_ASSERT(VTABLE_exists_keyed_str(d,
 108                     d->class_hash, class_name));
 109
 110                 VTABLE_delete_keyed_str(d, d->class_hash, class_name);
 111
 112                 if (last_remove == i + 1) {
 113                     --d->n_vtable_max;
 114                     last_remove = i;
 115                 }
 116             }
 117         }
 118     }
 119
 120     if (flags & PARROT_CLONE_LIBRARIES) {
 121         PMC   * const libs     = VTABLE_get_pmc_keyed_int(s, s->iglobals,
 122             IGLOBALS_DYN_LIBS);
 123         PMC   * const lib_iter = VTABLE_get_iter(s, libs);
 124         const INTVAL n         = VTABLE_elements(s, libs);
 125         INTVAL i;
 126
 127         for (i = 0; i < n; ++i) {
 128             STRING * const key     = VTABLE_shift_string(s, lib_iter);
 129             PMC    * const lib_pmc = VTABLE_get_pmc_keyed_str(s, libs, key);
 130             PMC    * const ignored = Parrot_clone_lib_into(d, s, lib_pmc);
 131             UNUSED(ignored);
 132         }
 133     }
 134
 135     if (flags & PARROT_CLONE_CLASSES) {
 136         INTVAL i;
 137         for (i = 0; i < s->n_vtable_max; ++i) {
 138             if (s->vtables[i] && s->vtables[i]->pmc_class &&
 139                     PObj_is_class_TEST(s->vtables[i]->pmc_class)) {
 140                 /* Cloning the class into the new interpreter ought
 141                  * to be sufficient to instantiate the class.  */
 142                 PMC                     * const source       = s->vtables[i]->pmc_class;
 143                 PMC                     * const dest         = Parrot_clone(d, source);
 144                 Parrot_Class_attributes * const source_class = PARROT_CLASS(source);
 145                 Parrot_Class_attributes * const dest_class   = PARROT_CLASS(dest);
 146
 147                 dest_class->name           = source_class->name;
 148                 dest_class->_namespace     = VTABLE_clone(d, source_class->_namespace);
 149             }
 150         }
 151     }
 152
 153     if (flags & PARROT_CLONE_CODE)
 154         pt_clone_code(d, s);
 155
 156     if (flags & PARROT_CLONE_GLOBALS)
 157         pt_clone_globals(d, s);
 158
 159     Parrot_unblock_GC_mark(d);
 160 }
 161
 162
 163 /*
 164
 165 =item C<static void create_interp(PMC *self, Parrot_Interp parent)>
 166
 167 Creates a new child interpreter of C<parent>.
 168
 169 =cut
 170
 171 */
 172
 173 static void
 174 create_interp(ARGIN(PMC *self), ARGIN_NULLOK(Parrot_Interp parent))
 175 {
 176     ASSERT_ARGS(create_interp)
 177     Interp_flags flag  = PARROT_NO_FLAGS;
 178     Parrot_Interp new_interp;
 179
 180     if (self->vtable->base_type == enum_class_ParrotThread)
 181         flag = PARROT_IS_THREAD;
 182
 183     new_interp       = make_interpreter(parent, (INTVAL)flag);
 184     PMC_interp(self) = new_interp;
 185
 186     VTABLE_set_pmc_keyed_int(new_interp, new_interp->iglobals,
 187         (INTVAL) IGLOBALS_INTERPRETER, self);
 188
 189     new_interp->current_cont = NEED_CONTINUATION;
 190 }
 191
 192 pmclass ParrotInterpreter no_ro manual_attrs provides invokable {
 193     ATTR struct parrot_interp_t *interp; /* this PMC's interpreter */
 194     ATTR INTVAL                  tid;    /* thread id */
 195     ATTR PMC                    *args;   /* args passed to this thread */
 196     ATTR PMC                    *sub;    /* this thread's sub */
 197
 198 /*
 199
 200 =back
 201
 202 =head2 Methods
 203
 204 =over 4
 205
 206 =item C<yield>
 207
 208 Yield the current thread
 209
 210 =item C<recursion_limit(INTVAL l :optional, INTVAL has_l :opt_flag )>
 211
 212 Gets the recursion limit of the interpreter, optionally setting it to something
 213 new.
 214
 215 =cut
 216
 217 */
 218
 219     METHOD yield() {
 220         pt_thread_yield();
 221     }
 222
 223     METHOD recursion_limit(INTVAL l :optional, INTVAL has_l :opt_flag) {
 224         const INTVAL ret = INTERP->recursion_limit;
 225         if (has_l)
 226             INTERP->recursion_limit = l;
 227         RETURN(INTVAL ret);
 228     }
 229
 230 /*
 231
 232 =item C<void init()>
 233
 234 Initializes the interpreter.
 235
 236 =cut
 237
 238 */
 239
 240     VTABLE void init() {
 241         /*
 242          * init/init_pmc may be called internally (from thread creation in
 243          * ParrotThread::init_pmc() or stand-alone
 244          * so we check, if the interpreter is already set up
 245          */
 246         if (!PMC_data(SELF)) {
 247             Parrot_ParrotInterpreter_attributes * const attrs =
 248                 mem_gc_allocate_zeroed_typed(INTERP, Parrot_ParrotInterpreter_attributes);
 249             PMC_data(SELF) = attrs;
 250         }
 251         if (!PMC_interp(SELF)) {
 252             create_interp(SELF, INTERP);
 253         }
 254         PObj_custom_destroy_SET(SELF);
 255     }
 256
 257 /*
 258
 259 =item C<void init_pmc(PMC *parent)>
 260
 261 Initializes a child interpreter with C<*parent> if C<parent> is
 262 a ParrotInterpreter instance. Otherwise takes the thread ID from
 263 C<parent> and uses that thread.
 264
 265 =cut
 266
 267 */
 268
 269     VTABLE void init_pmc(PMC *parent) {
 270         /* XXX Can this be moved inside the block where it's used */
 271         Parrot_Interp p = PMC_interp(parent);
 272
 273         if (!PMC_data(SELF)) {
 274             Parrot_ParrotInterpreter_attributes * const attrs =
 275                 mem_gc_allocate_zeroed_typed(INTERP, Parrot_ParrotInterpreter_attributes);
 276             PMC_data(SELF) = attrs;
 277         }
 278         if (!PMC_interp(SELF)) {
 279             create_interp(SELF, p);
 280         }
 281         PObj_custom_destroy_SET(SELF);
 282     }
 283
 284
 285 /*
 286
 287 =item C<void destroy()>
 288
 289 Destroys the PMC.
 290
 291 =cut
 292
 293 */
 294
 295     VTABLE void destroy() {
 296         if (PMC_data(SELF)) {
 297             mem_gc_free(INTERP, PMC_data(SELF));
 298             PMC_data(SELF) = NULL;
 299         }
 300     }
 301
 302
 303 /*
 304
 305 =item C<void set_pointer(void *value)>
 306
 307 Sets C<struct_val> to C<*value>.
 308
 309 =cut
 310
 311 */
 312
 313     VTABLE void set_pointer(void *value) {
 314
 315         /* XXX: init_world in src/global_setup.c needs to create a
 316          * ParrotInterpreter through Parrot_pmc_new_noinit.  If this PMC hasn't been
 317          * initialized, cheat by initializing instead. */
 318         if (!PMC_data(SELF)) {
 319             Parrot_ParrotInterpreter_attributes * const attrs =
 320                 mem_gc_allocate_zeroed_typed(INTERP, Parrot_ParrotInterpreter_attributes);
 321             PMC_data(SELF) = attrs;
 322             PObj_custom_destroy_SET(SELF);
 323         }
 324         PMC_interp(SELF) = (struct parrot_interp_t *)value;
 325     }
 326
 327 /*
 328
 329 =item C<void *get_pointer()>
 330
 331 Returns C<struct_val>.
 332
 333 =cut
 334
 335 */
 336
 337     VTABLE void *get_pointer() {
 338         return PMC_interp(SELF);
 339     }
 340
 341 /*
 342
 343 =item C<INTVAL get_integer()>
 344
 345 Returns the thread id of the interpreter.
 346
 347 =cut
 348
 349 */
 350
 351     VTABLE INTVAL get_integer() {
 352         const Parrot_Interp i = PMC_interp(SELF);
 353         if (i->thread_data)
 354           return (INTVAL)i->thread_data->tid;
 355         return 0;
 356     }
 357
 358 /*
 359
 360 =item C<opcode_t *invoke(void *next)>
 361
 362 Runs the interpreter's byte code.
 363
 364 =cut
 365
 366 */
 367
 368     VTABLE opcode_t *invoke(void *next) {
 369         Interp * const new_interp = PMC_interp(SELF);
 370
 371         /* setup code */
 372         pt_thread_prepare_for_run(new_interp, INTERP);
 373
 374         /* TODO pass arguments from parent (interp) to child (new_interp) by
 375          * possibly clone of share the arguments r/o args can be passed as is */
 376
 377         /* calculate offset and run */
 378         runops(new_interp, (size_t)((opcode_t *)PMC_sub(SELF) -
 379             (opcode_t *)INTERP->code->base.data));
 380
 381         return (opcode_t *)next;
 382     }
 383
 384 /*
 385
 386 =item C<PMC *get_pmc()>
 387
 388 Return this Thread's args.
 389
 390 =cut
 391
 392 */
 393
 394     VTABLE PMC *get_pmc() {
 395         return PMC_args(SELF);
 396     }
 397
 398 /*
 399
 400 =item C<void set_pmc(PMC *args)>
 401
 402 Set this Thread's args.
 403
 404 =cut
 405
 406 */
 407
 408     VTABLE void set_pmc(PMC *args) {
 409         PMC_args(SELF) = args;
 410     }
 411
 412
 413 /*
 414
 415 =item C<PMC *get_pmc_keyed_int(INTVAL key)>
 416
 417 Returns the PMC global value for C<key>.
 418
 419 =cut
 420
 421 */
 422
 423     VTABLE PMC *get_pmc_keyed_int(INTVAL key) {
 424         Interp * const new_interp = PMC_interp(SELF);
 425
 426         if (key >= 0 && key < IGLOBALS_SIZE)
 427             return VTABLE_get_pmc_keyed_int(new_interp,
 428                 new_interp->iglobals, key);
 429
 430         /* quick hack to get the global stash */
 431         if (key == -1)
 432             return new_interp->root_namespace;
 433
 434         return PMCNULL;
 435     }
 436
 437 /*
 438
 439 =item C<PMC *get_pmc_keyed(PMC *key)>
 440
 441 Introspection interface. C<key> can be:
 442
 443   "context"                 ... return Context PMC
 444   "sub"                     ... return Sub object of this subroutine
 445   "continuation"            ... return Continuation PMC
 446   "lexpad"                  ... return lexpad PMC for this sub
 447   "namespace"               ... return namespace PMC for this sub
 448   "outer"                   ... return outer sub of this closure
 449   "<item>"; level           ... same for caller <level>
 450   "annotations"; level > 0  ... annotations at point of call <level>s down
 451   "outer"; "<item>"         ... same for outer level 1
 452   "outer"; "<item>"; level  ... same for outer <level>
 453   "globals"                 ... return global stash
 454
 455 =cut
 456
 457 */
 458
 459     VTABLE PMC *get_pmc_keyed(PMC *key) {
 460         PMC    *nextkey;
 461         STRING *outer = NULL;
 462         STRING *item  = key_string(INTERP, key);
 463         STRING *name  = CONST_STRING(INTERP, "globals");
 464         int     level = 0;
 465
 466         PMC *ctx;
 467
 468         if (Parrot_str_equal(INTERP, item, name))
 469             return INTERP->root_namespace;
 470
 471         name  = CONST_STRING(INTERP, "outer");
 472
 473         if (Parrot_str_equal(INTERP, item, name)) {
 474             outer   = item;
 475             nextkey = key_next(INTERP, key);
 476
 477             if (nextkey && (PObj_get_FLAGS(nextkey) & KEY_string_FLAG)) {
 478                 key  = nextkey;
 479                 item = VTABLE_get_string(INTERP, key);
 480             }
 481         }
 482
 483         nextkey = key_next(INTERP, key);
 484
 485         if (nextkey)
 486             level = VTABLE_get_integer(INTERP, nextkey);
 487         else if (outer)
 488             level = 1;
 489
 490         if (level < 0)
 491             Parrot_ex_throw_from_c_args(INTERP, NULL, CONTROL_ERROR,
 492                 "No such caller depth");
 493
 494         ctx = CURRENT_CONTEXT(INTERP);
 495
 496         if (outer) {
 497             for (; level; --level) {
 498                 ctx = Parrot_pcc_get_outer_ctx(INTERP, ctx);
 499                 if (PMC_IS_NULL(ctx))
 500                     Parrot_ex_throw_from_c_args(INTERP, NULL,
 501                         CONTROL_ERROR, "No such outer depth");
 502             }
 503         }
 504         else {
 505             for (; level; --level) {
 506                 PMC * const cont = Parrot_pcc_get_continuation(INTERP, ctx);
 507
 508                 if (PMC_IS_NULL(cont) || !PARROT_CONTINUATION(cont)->seg)
 509                     Parrot_ex_throw_from_c_args(INTERP, NULL,
 510                         CONTROL_ERROR, "No such caller depth");
 511
 512                 ctx = PARROT_CONTINUATION(cont)->to_ctx;
 513
 514                 if (PMC_IS_NULL(Parrot_pcc_get_sub(INTERP, ctx)))
 515                     Parrot_ex_throw_from_c_args(INTERP, NULL,
 516                         CONTROL_ERROR, "No such caller depth");
 517             }
 518         }
 519
 520         if (item == outer)
 521             return Parrot_pcc_get_sub(INTERP, ctx);
 522
 523         name = CONST_STRING(INTERP, "context");
 524
 525         if (Parrot_str_equal(INTERP, item, name))
 526             return ctx;
 527
 528         name = CONST_STRING(INTERP, "sub");
 529
 530         if (Parrot_str_equal(INTERP, item, name))
 531             return Parrot_pcc_get_sub(INTERP, ctx);
 532
 533         name = CONST_STRING(INTERP, "lexpad");
 534
 535         if (Parrot_str_equal(INTERP, item, name))
 536             return Parrot_pcc_get_lex_pad(INTERP, ctx);
 537
 538         name = CONST_STRING(INTERP, "namespace");
 539
 540         if (Parrot_str_equal(INTERP, item, name))
 541             return Parrot_pcc_get_namespace(INTERP, ctx);
 542
 543         name = CONST_STRING(INTERP, "continuation");
 544
 545         if (Parrot_str_equal(INTERP, item, name))
 546             return VTABLE_clone(INTERP, Parrot_pcc_get_continuation(INTERP, ctx));
 547
 548         name = CONST_STRING(INTERP, "annotations");
 549
 550         if (Parrot_str_equal(INTERP, item, name)) {
 551             PMC        *sub_pmc = Parrot_pcc_get_sub(INTERP, ctx);
 552             if (ctx == CURRENT_CONTEXT(INTERP)) {
 553                 /* We can't know the current program counter for the currently
 554                  * executing sub, so can't return annotations for that. */
 555                 Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
 556                         "Cannot get annotations at depth 0; use annotations op instead.");
 557             }
 558             if (!PMC_IS_NULL(sub_pmc)
 559             &&   sub_pmc->vtable->base_type == enum_class_Sub) {
 560                 Parrot_Sub_attributes *sub;
 561                 PackFile_ByteCode     *seg;
 562                 opcode_t              *pc  = Parrot_pcc_get_pc(INTERP, ctx);
 563
 564                 PMC_get_sub(INTERP, sub_pmc, sub);
 565                 seg = sub->seg;
 566
 567                 if (sub->seg->annotations)
 568                     return PackFile_Annotations_lookup(INTERP, seg->annotations,
 569                         pc - seg->base.data, NULL);
 570             }
 571
 572             return Parrot_pmc_new(INTERP, enum_class_Hash);
 573         }
 574
 575         Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_ATTRIB_NOT_FOUND,
 576                 "No such item %Ss", item);
 577     }
 578
 579 /*
 580
 581 =item C<INTVAL get_integer_keyed_int(INTVAL key)>
 582
 583 Returns the interpreter info for C<key>.
 584
 585 =cut
 586
 587 */
 588
 589     VTABLE INTVAL get_integer_keyed_int(INTVAL key) {
 590         Interp * const new_interp = PMC_interp(SELF);
 591
 592         if (key == -1)
 593             return (INTVAL)new_interp->flags;
 594
 595         return interpinfo(new_interp, key);
 596     }
 597
 598 /*
 599
 600 =item C<void set_integer_keyed_int(INTVAL key, INTVAL val)>
 601
 602 Sets the interpreter info for C<key> to C<val>.
 603
 604 =cut
 605
 606 */
 607
 608     VTABLE void set_integer_keyed_int(INTVAL key, INTVAL val) {
 609         Interp * const new_interp = PMC_interp(SELF);
 610
 611         /* set interpreter flags */
 612         if (key == -1) {
 613             const INTVAL allowed = PARROT_BOUNDS_FLAG | PARROT_PROFILE_FLAG |
 614                              PARROT_GC_DEBUG_FLAG;
 615             Parrot_clear_flag(new_interp, allowed);
 616             Parrot_set_flag(new_interp, val & allowed);
 617         }
 618     }
 619
 620 /*
 621
 622 =item C<PMC *clone()>
 623
 624 First attempt to make things running, and to see, where problems may
 625 arise. Only minimal items are done yet.
 626
 627 XXX this should of course call C<Parrot_clone()> and use freeze/thaw.
 628
 629 =cut
 630
 631 */
 632
 633     VTABLE PMC *clone() {
 634         PMC * const dest = Parrot_pmc_new(INTERP, SELF->vtable->base_type);
 635
 636         clone_interpreter(PMC_interp(dest),
 637                           PMC_interp(SELF), PARROT_CLONE_DEFAULT);
 638
 639         return dest;
 640     }
 641
 642 /*
 643
 644 =item C<INTVAL is_equal(PMC *val)>
 645
 646 Returns whether the interpreter is equal to C<*val>.
 647
 648 Two interpreters (threads) are equal if both are non-threaded or they
 649 have the same thread id.
 650
 651 =cut
 652
 653 */
 654
 655     MULTI INTVAL is_equal(ParrotInterpreter val) {
 656         Parrot_Interp self  = PMC_interp(SELF);
 657         Parrot_Interp other = PMC_interp(val);
 658
 659         if (!self->thread_data && !other->thread_data)
 660             return 1;
 661
 662         if (self->thread_data && other->thread_data &&
 663             self->thread_data->tid == other->thread_data->tid)
 664             return 1;
 665
 666         return 0;
 667     }
 668
 669     MULTI INTVAL is_equal(ParrotThread value) {
 670         Parrot_Interp self  = PMC_interp(SELF);
 671
 672         if (!self->thread_data)
 673             return 0;
 674
 675         return self->thread_data->tid == (UINTVAL) VTABLE_get_integer(INTERP, value);
 676     }
 677
 678     MULTI INTVAL is_equal(DEFAULT value) {
 679         Parrot_ex_throw_from_c_args(INTERP, NULL,
 680                 EXCEPTION_INTERNAL_NOT_IMPLEMENTED,
 681                 "ParrotInterpreter: no multiple dispatch variant 'is_equal' for %Ss",
 682                 VTABLE_name(INTERP, value));
 683     }
 684
 685 /*
 686
 687 =item C<void visit(PMC *info)>
 688
 689 This is used by freeze/thaw to visit the contents of the interpreter.
 690
 691 C<*info> is the visit info, (see F<include/parrot/pmc_freeze.h>).
 692
 693 =item C<void freeze(PMC *info)>
 694
 695 Used to archive the interpreter. Actually not the whole interpreter is
 696 frozen but the state of the interpreter, which includes everything that
 697 has changes since creating an empty interpreter.
 698
 699 =item C<void thaw(PMC *info)>
 700
 701 Used to unarchive the interpreter. This merges the changes into this
 702 interpreter instance.
 703
 704 =item C<void thawfinish(PMC *info)>
 705
 706 Finish thawing.
 707
 708 =cut
 709
 710 */
 711
 712     VTABLE void visit(PMC *info) {
 713         /*
 714          * the information frozen here is part of all PBCs
 715          * we probably need to freeze all dynamic extensible
 716          * mappings (or at least the dynamic part)
 717          * e.g.
 718          *    charsets   idx - name
 719          *    encodings  idx - name
 720          *    pmc types  idx - name
 721          *    dynamic oplibs    opcode nr - opname
 722          *
 723          * The machine thawing this info still needs to load
 724          * these extensions, but the order of loading could be
 725          * relaxed.
 726          *
 727          * creating all these info as standard PMCs would vastly
 728          * simplify this process
 729          *
 730          * thaw would then need a merge operation:
 731          *  - compare existing for sanity
 732          *  - extend new
 733          */
 734
 735         /*  HLL_info */
 736         if (VTABLE_get_integer(INTERP, info) == VISIT_THAW_NORMAL ||
 737             VTABLE_get_integer(INTERP, info) == VISIT_THAW_CONSTANTS) {
 738             VISIT_PMC(INTERP, info, PMC_args(SELF));
 739         }
 740         else
 741             VISIT_PMC(INTERP, info, INTERP->HLL_info);
 742
 743     }
 744
 745     VTABLE void thaw(PMC *info) {
 746         if (!PMC_data(SELF)) {
 747             Parrot_ParrotInterpreter_attributes * const attrs =
 748                 mem_gc_allocate_zeroed_typed(INTERP, Parrot_ParrotInterpreter_attributes);
 749             PMC_data(SELF) = attrs;
 750             PObj_custom_destroy_SET(SELF);
 751         }
 752
 753         PMC_interp(SELF) = INTERP;
 754     }
 755
 756     VTABLE void thawfinish(PMC *info) {
 757         PMC * const new_info = PMC_args(SELF);
 758         const INTVAL  m      = VTABLE_elements(INTERP, new_info);
 759         INTVAL  i;
 760         UNUSED(info)
 761
 762         PMC_args(SELF) = NULL;
 763
 764         /* merge new_info */
 765         /* TODO compare old entries */
 766
 767         for (i = 0; i < m; ++i) {
 768             PMC * const entry    = VTABLE_get_pmc_keyed_int(INTERP, new_info, i);
 769             PMC * const lib_pmc  = VTABLE_get_pmc_keyed_int(INTERP, entry, e_HLL_lib);
 770             PMC * const name_pmc = VTABLE_get_pmc_keyed_int(INTERP, entry, e_HLL_name);
 771             PMC * const typemap  = VTABLE_get_pmc_keyed_int(INTERP, entry, e_HLL_typemap);
 772             INTVAL hll_id = - 1;
 773
 774             if (!PMC_IS_NULL(name_pmc)) {
 775                 STRING * const hll_name = VTABLE_get_string(INTERP, name_pmc);
 776
 777                 hll_id           = Parrot_register_HLL(INTERP, hll_name);
 778             }
 779
 780             if (!PMC_IS_NULL(lib_pmc)) {
 781                 STRING * const lib_name = VTABLE_get_string(INTERP, lib_pmc);
 782
 783                 if (!STRING_IS_EMPTY(lib_name)) {
 784                     PMC * const ignored = Parrot_load_lib(INTERP, lib_name, NULL);
 785                     const INTVAL id     = Parrot_register_HLL_lib(INTERP, lib_name);
 786                     UNUSED(id);
 787                 }
 788             }
 789
 790             if (hll_id >= 0 && !PMC_IS_NULL(typemap)) {
 791                 PMC   * const iter = VTABLE_get_iter(INTERP, typemap);
 792                 const INTVAL e     = VTABLE_get_integer(INTERP, typemap);
 793                 INTVAL i;
 794
 795                 for (i = 0; i < e; ++i) {
 796                     PMC * const key        = VTABLE_shift_pmc(INTERP, iter);
 797                     const INTVAL core_type = VTABLE_get_integer(INTERP, key);
 798                     const INTVAL hll_type  =
 799                         VTABLE_get_integer_keyed_int(INTERP, typemap, core_type);
 800
 801                     Parrot_register_HLL_type(INTERP, hll_id,
 802                         core_type, hll_type);
 803                 }
 804             }
 805         }
 806     }
 807
 808     METHOD run_gc() {
 809         Parrot_gc_mark_and_sweep(PMC_interp(SELF), 0);
 810     }
 811
 812 /*
 813
 814 =item METHOD hll_map(PMC core_type,PMC hll_type)
 815
 816 Map core_type to hll_type.
 817
 818 =cut
 819
 820 */
 821
 822     METHOD hll_map(PMC *core_type, PMC *hll_type) {
 823         const INTVAL core_type_id = VTABLE_type(INTERP, core_type);
 824         const INTVAL hll_type_id  = VTABLE_type(INTERP, hll_type);
 825         const INTVAL hll_id       = Parrot_pcc_get_HLL(INTERP, CURRENT_CONTEXT(INTERP));
 826         Parrot_register_HLL_type(INTERP, hll_id, core_type_id, hll_type_id);
 827     }
 828
 829 /*
 830
 831 =item METHOD stdhandle(INTVAL fileno, PMC *newhandle :optional)
 832
 833 Returns the standard parrot handler associated with the interpreter.
 834 The valid values for fileno are listed in include/stdio.pasm
 835
 836 Optionally sets the parrot handler passed as second argument
 837 as the specified standard handler.
 838
 839 This method is experimental. See TT #264.
 840
 841 =cut
 842
 843 */
 844
 845     METHOD stdhandle(INTVAL fileno, PMC *newhandle :optional) {
 846         PMC * const handle = Parrot_io_stdhandle(INTERP, fileno, newhandle);
 847         Parrot_warn_deprecated(INTERP, "stdhandle method is experimental");
 848         RETURN(PMC *handle);
 849     }
 850
 851 /*
 852
 853 =item METHOD getpid()
 854
 855 Returns the pid of the current process, 0 in platforms that doesn't
 856 support it.
 857
 858 This method is experimental. See TT #1564.
 859
 860 =cut
 861
 862 */
 863
 864     METHOD getpid() {
 865         INTVAL id = Parrot_getpid();
 866         RETURN(INTVAL id);
 867     }
 868
 869 }
 870
 871 /*
 872
 873 =back
 874
 875 =cut
 876
 877 */
 878
 879 /*
 880  * Local variables:
 881  *   c-file-style: "parrot"
 882  * End:
 883  * vim: expandtab shiftwidth=4:
 884  */