src/embed.c

   1 /*
   2 Copyright (C) 2001-2008, The Perl Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 src/embed.c - The Parrot embedding interface
   8
   9 =head1 DESCRIPTION
  10
  11 This file implements the Parrot embedding interface.
  12
  13 =head2 Functions
  14
  15 =over 4
  16
  17 =cut
  18
  19 */
  20
  21 #include "parrot/parrot.h"
  22 #include "parrot/embed.h"
  23 #include "parrot/oplib/ops.h"
  24
  25 /* HEADERIZER HFILE: none */ /* The visible types are different than what we use in here */
  26
  27 /* HEADERIZER BEGIN: static */
  28
  29 static FLOATVAL calibrate(PARROT_INTERP)
  30         __attribute__nonnull__(1);
  31
  32 PARROT_CANNOT_RETURN_NULL
  33 static const char * op_name(PARROT_INTERP, int k)
  34         __attribute__nonnull__(1);
  35
  36 static void print_debug(PARROT_INTERP, SHIM(int status), SHIM(void *p))
  37         __attribute__nonnull__(1);
  38
  39 static void print_profile(PARROT_INTERP, SHIM(int status), SHIM(void *p))
  40         __attribute__nonnull__(1);
  41
  42 static int prof_sort_f(ARGIN(const void *a), ARGIN(const void *b))
  43         __attribute__nonnull__(1)
  44         __attribute__nonnull__(2);
  45
  46 PARROT_CANNOT_RETURN_NULL
  47 static PMC* set_current_sub(PARROT_INTERP)
  48         __attribute__nonnull__(1);
  49
  50 PARROT_CANNOT_RETURN_NULL
  51 static PMC* setup_argv(PARROT_INTERP, int argc, ARGIN(const char **argv))
  52         __attribute__nonnull__(1)
  53         __attribute__nonnull__(3);
  54
  55 /* HEADERIZER END: static */
  56
  57 extern int Parrot_exec_run;
  58
  59 /*
  60
  61 =item C<Parrot_Interp Parrot_new>
  62
  63 Returns a new Parrot interpreter.
  64
  65 The first created interpreter (C<parent> is C<NULL>) is the last one
  66 to get destroyed.
  67
  68 =cut
  69
  70 */
  71
  72 #ifdef JIT_CAPABLE
  73 #  if EXEC_CAPABLE
  74 #    include "parrot/exec.h"
  75 #  endif /* EXEC_CAPABLE */
  76 #  include "jit.h"
  77 #endif
  78
  79 PARROT_API
  80 PARROT_CANNOT_RETURN_NULL
  81 Parrot_Interp
  82 Parrot_new(ARGIN_NULLOK(Parrot_Interp parent))
  83 {
  84     /* inter_create.c:make_interpreter builds a new Parrot_Interp. */
  85     return make_interpreter(parent, PARROT_NO_FLAGS);
  86 }
  87
  88 extern void Parrot_initialize_core_pmcs(PARROT_INTERP);
  89
  90 /*
  91
  92 =item C<void Parrot_init_stacktop>
  93
  94 Initializes the new interpreter when it hasn't been initialized before.
  95
  96 Additionally sets the stack top, so that Parrot objects created
  97 in inner stack frames will be visible during DODs stack walking code.
  98 B<stack_top> should be the address of an automatic variable in the caller's
  99 stack frame. All unanchored Parrot objects (PMCs) must live in inner stack
 100 frames so that they are not destroyed during DOD runs.
 101
 102 Use this function when you call into Parrot before entering a run loop.
 103
 104 =cut
 105
 106 */
 107
 108 PARROT_API
 109 void
 110 Parrot_init_stacktop(PARROT_INTERP, void *stack_top)
 111 {
 112     interp->lo_var_ptr = stack_top;
 113     init_world_once(interp);
 114 }
 115
 116 /*
 117
 118 =item C<void Parrot_set_flag>
 119
 120 Sets on any of the following flags, specified by C<flag>, in the interpreter:
 121
 122 Flag                    Effect
 123 C<PARROT_BOUNDS_FLAG>   enable bounds checking
 124 C<PARROT_PROFILE_FLAG>  enable profiling,
 125 C<PARROT_THR_TYPE_1>    disable variable sharing and thread communication
 126 C<PARROT_THR_TYPE_2>    disable variable sharing but enable thread communication
 127 C<PARROT_THR_TYPE_3>    enable variable sharing.
 128
 129 =cut
 130
 131 */
 132
 133 PARROT_API
 134 void
 135 Parrot_set_flag(PARROT_INTERP, INTVAL flag)
 136 {
 137     /* These two macros (from interpreter.h) do exactly what they look like. */
 138
 139     Interp_flags_SET(interp, flag);
 140     switch (flag) {
 141         case PARROT_BOUNDS_FLAG:
 142         case PARROT_PROFILE_FLAG:
 143             Interp_core_SET(interp, PARROT_SLOW_CORE);
 144             break;
 145         default:
 146             break;
 147     }
 148 }
 149
 150 /*
 151
 152 =item C<void Parrot_set_debug>
 153
 154 Set a debug flag: C<PARROT_DEBUG_FLAG>.
 155
 156 =cut
 157
 158 */
 159
 160 PARROT_API
 161 void
 162 Parrot_set_debug(PARROT_INTERP, UINTVAL flag)
 163 {
 164     interp->debug_flags |= flag;
 165 }
 166
 167 /*
 168
 169 =item C<void Parrot_set_executable_name>
 170
 171 Sets the name of the executable launching Parrot (see C<pbc_to_exe> and the
 172 C<parrot> binary).
 173
 174 =cut
 175
 176 */
 177
 178 PARROT_API
 179 void
 180 Parrot_set_executable_name(PARROT_INTERP, Parrot_Pointer name)
 181 {
 182     PMC * const name_pmc = pmc_new(interp, enum_class_String);
 183     VTABLE_set_string_native(interp, name_pmc, (STRING *)name);
 184     VTABLE_set_pmc_keyed_int(interp, interp->iglobals, IGLOBALS_EXECUTABLE,
 185         name_pmc);
 186 }
 187
 188 /*
 189
 190 =item C<void Parrot_set_trace>
 191
 192 Set a trace flag: C<PARROT_TRACE_FLAG>
 193
 194 =cut
 195
 196 */
 197
 198 PARROT_API
 199 void
 200 Parrot_set_trace(PARROT_INTERP, UINTVAL flag)
 201 {
 202     CONTEXT(interp->ctx)->trace_flags |= flag;
 203     Interp_core_SET(interp, PARROT_SLOW_CORE);
 204 }
 205
 206 /*
 207
 208 =item C<void Parrot_clear_flag>
 209
 210 Clears a flag in the interpreter.
 211
 212 =cut
 213
 214 */
 215
 216 PARROT_API
 217 void
 218 Parrot_clear_flag(PARROT_INTERP, INTVAL flag)
 219 {
 220     Interp_flags_CLEAR(interp, flag);
 221 }
 222
 223 /*
 224
 225 =item C<void Parrot_clear_debug>
 226
 227 Clears a flag in the interpreter.
 228
 229 =cut
 230
 231 */
 232
 233 PARROT_API
 234 void
 235 Parrot_clear_debug(PARROT_INTERP, UINTVAL flag)
 236 {
 237     interp->debug_flags &= ~flag;
 238 }
 239
 240 /*
 241
 242 =item C<void Parrot_clear_trace>
 243
 244 Clears a flag in the interpreter.
 245
 246 =cut
 247
 248 */
 249
 250 PARROT_API
 251 void
 252 Parrot_clear_trace(PARROT_INTERP, UINTVAL flag)
 253 {
 254     CONTEXT(interp->ctx)->trace_flags &= ~flag;
 255 }
 256
 257 /*
 258
 259 =item C<Parrot_Int Parrot_test_flag>
 260
 261 Test the interpreter flags specified in C<flag>.
 262
 263 =cut
 264
 265 */
 266
 267 PARROT_API
 268 Parrot_Int
 269 Parrot_test_flag(PARROT_INTERP, INTVAL flag)
 270 {
 271     return Interp_flags_TEST(interp, flag);
 272 }
 273
 274 /*
 275
 276 =item C<UINTVAL Parrot_test_debug>
 277
 278 Test the interpreter flags specified in C<flag>.
 279
 280 =cut
 281
 282 */
 283
 284 PARROT_API
 285 UINTVAL
 286 Parrot_test_debug(PARROT_INTERP, UINTVAL flag)
 287 {
 288     return interp->debug_flags & flag;
 289 }
 290
 291 /*
 292
 293 =item C<UINTVAL Parrot_test_trace>
 294
 295 Test the interpreter flags specified in C<flag>.
 296
 297 =cut
 298
 299 */
 300
 301 PARROT_API
 302 UINTVAL
 303 Parrot_test_trace(PARROT_INTERP, UINTVAL flag)
 304 {
 305     return CONTEXT(interp->ctx)->trace_flags & flag;
 306 }
 307
 308 /*
 309
 310 =item C<void Parrot_set_run_core>
 311
 312 Sets the specified run core.
 313
 314 =cut
 315
 316 */
 317
 318 PARROT_API
 319 void
 320 Parrot_set_run_core(PARROT_INTERP, Parrot_Run_core_t core)
 321 {
 322     Interp_core_SET(interp, core);
 323 }
 324
 325 /*
 326
 327 =item C<void Parrot_setwarnings>
 328
 329 Activates the given warnings.
 330
 331 =cut
 332
 333 */
 334
 335 PARROT_API
 336 void
 337 Parrot_setwarnings(PARROT_INTERP, Parrot_warnclass wc)
 338 {
 339     /* Activates the given warnings.  (Macro from warnings.h.) */
 340     PARROT_WARNINGS_on(interp, wc);
 341 }
 342
 343 /*
 344
 345 =item C<PackFile * Parrot_readbc>
 346
 347 Read in a bytecode, unpack it into a C<PackFile> structure, and do fixups.
 348
 349 =cut
 350
 351 */
 352
 353 PARROT_API
 354 PARROT_CAN_RETURN_NULL
 355 PackFile *
 356 Parrot_readbc(PARROT_INTERP, ARGIN_NULLOK(const char *fullname))
 357 {
 358     INTVAL program_size;
 359     char *program_code;
 360     PackFile *pf;
 361     FILE * io = NULL;
 362     INTVAL is_mapped = 0;
 363 #ifdef PARROT_HAS_HEADER_SYSMMAN
 364     int fd = -1;
 365 #endif
 366
 367     if (fullname == NULL || STREQ(fullname, "-")) {
 368         /* read from STDIN */
 369         io = stdin;
 370         /* read 1k at a time */
 371         program_size = 0;
 372     }
 373     else {
 374         STRING * const fs = string_make(interp, fullname,
 375                 strlen(fullname), NULL, 0);
 376         if (!Parrot_stat_info_intval(interp, fs, STAT_EXISTS)) {
 377             PIO_eprintf(interp, "Parrot VM: Can't stat %s, code %i.\n",
 378                     fullname, errno);
 379             return NULL;
 380         }
 381         /*
 382          * RT#46153 check for regular file
 383          */
 384
 385         program_size = Parrot_stat_info_intval(interp, fs, STAT_FILESIZE);
 386
 387 #ifndef PARROT_HAS_HEADER_SYSMMAN
 388         io = fopen(fullname, "rb");
 389         if (!io) {
 390             PIO_eprintf(interp, "Parrot VM: Can't open %s, code %i.\n",
 391                     fullname, errno);
 392             return NULL;
 393         }
 394 #endif  /* PARROT_HAS_HEADER_SYSMMAN */
 395
 396     }
 397 #ifdef PARROT_HAS_HEADER_SYSMMAN
 398 again:
 399 #endif
 400     /* if we've opened a file (or stdin) with PIO, read it in */
 401     if (io) {
 402         size_t chunk_size;
 403         char *cursor;
 404         INTVAL read_result;
 405         INTVAL wanted;
 406
 407         chunk_size = program_size > 0 ? program_size : 1024;
 408         program_code = (char *)mem_sys_allocate(chunk_size);
 409         wanted = program_size;
 410         program_size = 0;
 411         cursor = (char *)program_code;
 412
 413         while ((read_result = fread(cursor, 1, chunk_size, io)) > 0) {
 414             program_size += read_result;
 415             if (program_size == wanted)
 416                 break;
 417             chunk_size = 1024;
 418             program_code =
 419                 (char *)mem_sys_realloc(program_code, program_size + chunk_size);
 420
 421             if (!program_code) {
 422                 PIO_eprintf(interp,
 423                             "Parrot VM: Could not reallocate buffer "
 424                             "while reading packfile from PIO.\n");
 425                 return NULL;
 426             }
 427
 428             cursor = (char *)program_code + program_size;
 429         }
 430
 431         if (read_result < 0) {
 432             PIO_eprintf(interp,
 433                     "Parrot VM: Problem reading packfile from PIO.\n");
 434             return NULL;
 435         }
 436         fclose(io);
 437     }
 438     else {
 439         /* if we've gotten here, we opted not to use PIO to read the file.
 440          * use mmap */
 441
 442 #ifdef PARROT_HAS_HEADER_SYSMMAN
 443
 444         /* check that fullname isn't NULL, just in case */
 445         if (!fullname) {
 446             real_exception(interp, NULL, 1,
 447                     "About to try and open a NULL filename");
 448         }
 449
 450         fd = open(fullname, O_RDONLY | O_BINARY);
 451         if (!fd) {
 452             PIO_eprintf(interp, "Parrot VM: Can't open %s, code %i.\n",
 453                     fullname, errno);
 454             return NULL;
 455         }
 456
 457         program_code =
 458             (char *)mmap(0, program_size, PROT_READ, MAP_SHARED, fd, (off_t)0);
 459
 460         if (program_code == (void *)MAP_FAILED) {
 461             Parrot_warn(interp, PARROT_WARNINGS_IO_FLAG,
 462                     "Parrot VM: Can't mmap file %s, code %i.\n",
 463                     fullname, errno);
 464             /* try again, now with IO reading the file */
 465             io = fopen(fullname, "rb");
 466             if (!io) {
 467                 PIO_eprintf(interp,
 468                         "Parrot VM: Can't open %s, code %i.\n",
 469                         fullname, errno);
 470                 return NULL;
 471             }
 472             goto again;
 473         }
 474         is_mapped = 1;
 475
 476 #else   /* PARROT_HAS_HEADER_SYSMMAN */
 477
 478         PIO_eprintf(interp, "Parrot VM: uncaught error occurred reading "
 479                     "file or mmap not available.\n");
 480         return NULL;
 481
 482 #endif  /* PARROT_HAS_HEADER_SYSMMAN */
 483
 484     }
 485
 486     /* Now that we have the bytecode, let's unpack it. */
 487
 488     pf = PackFile_new(interp, is_mapped);
 489
 490     if (!PackFile_unpack(interp, pf, (opcode_t *)program_code, program_size)) {
 491         PIO_eprintf(interp, "Parrot VM: Can't unpack packfile %s.\n",
 492                 fullname);
 493         return NULL;
 494     }
 495
 496     /*
 497      * Set :main routine
 498      */
 499     do_sub_pragmas(interp, pf->cur_cs, PBC_PBC, NULL);
 500     /*
 501      * JITting and/or prederefing the sub/the bytecode is done
 502      * in switch_to_cs before actual usage of the segment
 503      */
 504
 505 #ifdef PARROT_HAS_HEADER_SYSMMAN
 506     if (fd >= 0) {
 507         close(fd);   /* the man page states, it's ok to close a mmaped file */
 508     }
 509 #else
 510 /* RT#46155 Parrot_exec uses this
 511     mem_sys_free(program_code); */
 512 #endif
 513
 514     return pf;
 515 }
 516
 517 /*
 518
 519 =item C<void Parrot_loadbc>
 520
 521 Loads the C<PackFile> returned by C<Parrot_readbc()>.
 522
 523 =cut
 524
 525 */
 526
 527 PARROT_API
 528 void
 529 Parrot_loadbc(PARROT_INTERP, NOTNULL(PackFile *pf))
 530 {
 531     if (pf == NULL) {
 532         PIO_eprintf(interp, "Invalid packfile\n");
 533         return;
 534     }
 535     interp->initial_pf = pf;
 536     interp->code = pf->cur_cs;
 537 }
 538
 539 /*
 540
 541 =item C<static PMC* setup_argv>
 542
 543 Creates and returns C<ARGS> array PMC.
 544
 545 =cut
 546
 547 */
 548
 549 PARROT_CANNOT_RETURN_NULL
 550 static PMC*
 551 setup_argv(PARROT_INTERP, int argc, ARGIN(const char **argv))
 552 {
 553     INTVAL i;
 554     PMC *userargv;
 555
 556     if (Interp_debug_TEST(interp, PARROT_START_DEBUG_FLAG)) {
 557         PIO_eprintf(interp,
 558                 "*** Parrot VM: Setting up ARGV array."
 559                 " Current argc: %d ***\n",
 560                 argc);
 561     }
 562
 563     userargv = pmc_new_noinit(interp, enum_class_ResizableStringArray);
 564     /* immediately anchor pmc to root set */
 565     VTABLE_set_pmc_keyed_int(interp, interp->iglobals,
 566             (INTVAL)IGLOBALS_ARGV_LIST, userargv);
 567     VTABLE_init(interp, userargv);
 568
 569     for (i = 0; i < argc; i++) {
 570         /* Run through argv, adding everything to @ARGS. */
 571         STRING * const arg =
 572             string_make(interp, argv[i], strlen(argv[i]), NULL, PObj_external_FLAG);
 573
 574         if (Interp_debug_TEST(interp, PARROT_START_DEBUG_FLAG)) {
 575             PIO_eprintf(interp, "\t%vd: %s\n", i, argv[i]);
 576         }
 577
 578         VTABLE_push_string(interp, userargv, arg);
 579     }
 580     return userargv;
 581 }
 582
 583 /*
 584
 585 =item C<static int prof_sort_f>
 586
 587 Sort function for profile data. Sorts by time.
 588
 589 =cut
 590
 591 */
 592
 593 static int
 594 prof_sort_f(ARGIN(const void *a), ARGIN(const void *b))
 595 {
 596     const FLOATVAL timea = ((const ProfData *)a)->time;
 597     const FLOATVAL timeb = ((const ProfData *)b)->time;
 598
 599     if (timea < timeb)
 600         return 1;
 601     if (timea > timeb)
 602         return -1;
 603     return 0;
 604 }
 605
 606 /*
 607
 608 =item C<static const char * op_name>
 609
 610 Returns the name of the opcode.
 611
 612 =cut
 613
 614 */
 615
 616 PARROT_CANNOT_RETURN_NULL
 617 static const char *
 618 op_name(PARROT_INTERP, int k)
 619 {
 620     switch (k) {
 621         case PARROT_PROF_DOD_p1:
 622             return "DOD_mark_root";
 623         case PARROT_PROF_DOD_p2:
 624             return "DOD_mark_next";
 625         case PARROT_PROF_DOD_cp:
 626             return "DOD_collect_PMC";
 627         case PARROT_PROF_DOD_cb:
 628             return "DOD_collect_buffers";
 629         case PARROT_PROF_GC:
 630             return "GC";
 631         case PARROT_PROF_EXCEPTION:
 632             return "EXCEPTION";
 633         default:
 634             break;
 635     }
 636     return interp->op_info_table[k - PARROT_PROF_EXTRA].full_name;
 637 }
 638
 639 /*
 640
 641 =item C<static FLOATVAL calibrate>
 642
 643 With this calibration, reported times of C<parrot -p> almost match those
 644 measured with time C<parrot -b>.
 645
 646 =cut
 647
 648 */
 649
 650 static FLOATVAL
 651 calibrate(PARROT_INTERP)
 652 {
 653     size_t n = interp->op_count;
 654     size_t i;
 655     FLOATVAL start, empty;
 656     opcode_t code[] = { 1 };      /* noop */
 657     opcode_t *pc = code;
 658
 659     if (n < 1000000)    /* minimum opcode count for calibration */
 660         n = 1000000;
 661     start = Parrot_floatval_time();
 662     for (empty = 0.0, i = 0; i < n; i++)
 663        pc =  (interp->op_func_table[*code])(pc, interp);
 664     empty += Parrot_floatval_time() - start;
 665     return empty / (FLOATVAL)n;
 666 }
 667
 668 /*
 669
 670 =item C<static void print_profile>
 671
 672 Prints out a profile listing.
 673
 674 =cut
 675
 676 */
 677
 678 static void
 679 print_profile(PARROT_INTERP, SHIM(int status), SHIM(void *p))
 680 {
 681     RunProfile * const profile = interp->profile;
 682
 683     if (profile) {
 684         UINTVAL j;
 685         int k;
 686         int jit;
 687         UINTVAL op_count = 0;
 688         UINTVAL call_count = 0;
 689         FLOATVAL sum_time = 0.0;
 690         const FLOATVAL empty = calibrate(interp);
 691
 692         PIO_printf(interp,
 693                    " Code J Name                         "
 694                    "Calls  Total/s       Avg/ms\n");
 695         for (j = 0; j < interp->op_count + PARROT_PROF_EXTRA; j++) {
 696             const UINTVAL n = profile->data[j].numcalls;
 697             profile->data[j].op = j;
 698             if (j >= PARROT_PROF_EXTRA) {
 699                 profile->data[j].time -= empty * n;
 700                 if (profile->data[j].time < 0.0) /* faster than noop */
 701                     profile->data[j].time = 0.0;
 702             }
 703         }
 704         qsort(profile->data, interp->op_count +
 705                 PARROT_PROF_EXTRA,
 706                 sizeof (ProfData), prof_sort_f);
 707         for (j = 0; j < interp->op_count + PARROT_PROF_EXTRA; j++) {
 708             const UINTVAL n = profile->data[j].numcalls;
 709
 710             if (n > 0) {
 711                 const FLOATVAL t = profile->data[j].time;
 712
 713                 op_count++;
 714                 call_count += n;
 715                 sum_time += t;
 716
 717                 k = profile->data[j].op;
 718                 jit = '-';
 719 #if JIT_CAPABLE
 720                 if (k >= PARROT_PROF_EXTRA &&
 721                     op_jit[k - PARROT_PROF_EXTRA].extcall != 1)
 722                     jit = 'j';
 723 #endif
 724                 PIO_printf(interp, " %4d %c %-25s %8vu  %10vf  %10.6vf\n",
 725                         k - PARROT_PROF_EXTRA,
 726                         jit,
 727                         op_name(interp, k),
 728                         n,
 729                         t,
 730                         (FLOATVAL)(t * 1000.0 / (FLOATVAL)n));
 731             }
 732         }
 733
 734         PIO_printf(interp, " %4vu - %-25s %8vu  %10vf  %10.6vf\n",
 735                 op_count,
 736                 "-",
 737                 call_count,
 738                 sum_time,
 739                 (FLOATVAL)(sum_time * 1000.0 / (FLOATVAL)call_count));
 740     }
 741 }
 742
 743 /*
 744
 745 =item C<static void print_debug>
 746
 747 Prints GC info.
 748
 749 =cut
 750
 751 */
 752
 753 static void
 754 print_debug(PARROT_INTERP, SHIM(int status), SHIM(void *p))
 755 {
 756     if (Interp_debug_TEST(interp, PARROT_MEM_STAT_DEBUG_FLAG)) {
 757         /* Give the souls brave enough to activate debugging an earful
 758          * about GC. */
 759
 760         PIO_eprintf(interp, "*** Parrot VM: Dumping GC info ***\n");
 761         PDB_info(interp);
 762     }
 763 }
 764
 765 /*
 766
 767 =item C<static PMC* set_current_sub>
 768
 769 Search the fixup table for a PMC matching the argument.  On a match,
 770 set up the appropriate context.
 771
 772 If no match, set up a dummy PMC entry.  In either case, return a
 773 pointer to the PMC.
 774
 775 =cut
 776
 777 */
 778
 779 PARROT_CANNOT_RETURN_NULL
 780 static PMC*
 781 set_current_sub(PARROT_INTERP)
 782 {
 783     opcode_t i;
 784     PMC *sub_pmc;
 785
 786     PackFile_ByteCode * const cur_cs = interp->code;
 787     PackFile_FixupTable * const ft = cur_cs->fixups;
 788     PackFile_ConstTable * const ct = cur_cs->const_table;
 789
 790     /*
 791      * Walk the fixup table.  The first Sub-like entry should be our
 792      * entry point with the address at our resume_offset.
 793      */
 794
 795     for (i = 0; i < ft->fixup_count; i++) {
 796         if (ft->fixups[i]->type == enum_fixup_sub) {
 797             const opcode_t ci = ft->fixups[i]->offset;
 798             Parrot_sub *sub;
 799
 800             sub_pmc = ct->constants[ci]->u.key;
 801             sub = PMC_sub(sub_pmc);
 802             if (sub->seg == cur_cs) {
 803                 const size_t offs = sub->start_offs;
 804                 if (offs == interp->resume_offset) {
 805                     CONTEXT(interp->ctx)->current_sub = sub_pmc;
 806                     CONTEXT(interp->ctx)->current_HLL = sub->HLL_id;
 807                     return sub_pmc;
 808                 }
 809                 break;
 810             }
 811         }
 812     }
 813     /*
 814      * if we didn't find anything put a dummy PMC into current_sub
 815      */
 816     sub_pmc = pmc_new(interp, enum_class_Sub);
 817     PMC_sub(sub_pmc)->start_offs = 0;
 818     CONTEXT(interp->ctx)->current_sub = sub_pmc;
 819     return sub_pmc;
 820 }
 821
 822 /*
 823
 824 =item C<void Parrot_runcode>
 825
 826 Sets up C<ARGV> and runs the ops.
 827
 828 =cut
 829
 830 */
 831
 832 PARROT_API
 833 void
 834 Parrot_runcode(PARROT_INTERP, int argc, ARGIN(const char **argv))
 835 {
 836     PMC *userargv, *main_sub;
 837
 838     if (Interp_debug_TEST(interp, PARROT_START_DEBUG_FLAG)) {
 839         PIO_eprintf(interp,
 840                 "*** Parrot VM: Setting stack top. ***\n");
 841     }
 842     /* Debugging mode nonsense. */
 843     if (Interp_debug_TEST(interp, PARROT_START_DEBUG_FLAG)) {
 844         if (Interp_flags_TEST(interp, PARROT_BOUNDS_FLAG)) {
 845             PIO_eprintf(interp,
 846                     "*** Parrot VM: Bounds checking enabled. ***\n");
 847         }
 848         if (Interp_trace_TEST(interp, PARROT_TRACE_OPS_FLAG)) {
 849             PIO_eprintf(interp, "*** Parrot VM: Tracing enabled. ***\n");
 850         }
 851         PIO_eprintf(interp, "*** Parrot VM: ");
 852         switch (interp->run_core) {
 853             case PARROT_SLOW_CORE:
 854                 PIO_eprintf(interp, "Slow core");
 855                 break;
 856             case PARROT_FAST_CORE:
 857                 PIO_eprintf(interp, "Fast core");
 858                 break;
 859             case PARROT_SWITCH_CORE:
 860             case PARROT_SWITCH_JIT_CORE:
 861                 PIO_eprintf(interp, "Switch core");
 862                 break;
 863             case PARROT_CGP_CORE:
 864             case PARROT_CGP_JIT_CORE:
 865                 PIO_eprintf(interp, "CGP core");
 866                 break;
 867             case PARROT_CGOTO_CORE:
 868                 PIO_eprintf(interp, "CGoto core");
 869                 break;
 870             case PARROT_JIT_CORE:
 871                 PIO_eprintf(interp, "JIT core");
 872                 break;
 873             case PARROT_EXEC_CORE:
 874                 PIO_eprintf(interp, "EXEC core");
 875                 break;
 876             default:
 877                 real_exception(interp, NULL, 1, "Unknown run core");
 878         }
 879         PIO_eprintf(interp, " ***\n");
 880     }
 881
 882     /* Set up @ARGS (or whatever this language calls it) in userargv. */
 883     userargv = setup_argv(interp, argc, argv);
 884
 885 #if EXEC_CAPABLE
 886
 887     /* s. runops_exec interpreter.c */
 888     if (Interp_core_TEST(interp, PARROT_EXEC_CORE)) {
 889         Parrot_exec_run = 1;
 890     }
 891
 892 #endif
 893
 894     /*
 895      * If any profile information was gathered, print it out
 896      * before exiting, then print debug infos if turned on.
 897      */
 898     Parrot_on_exit(interp, print_debug,   NULL);
 899     Parrot_on_exit(interp, print_profile, NULL);
 900
 901     /* Let's kick the tires and light the fires--call interpreter.c:runops. */
 902     main_sub = CONTEXT(interp->ctx)->current_sub;
 903     /*
 904      * if no sub was marked being :main, we create a dummy sub with offset 0
 905      */
 906     if (!main_sub) {
 907         main_sub = set_current_sub(interp);
 908     }
 909     CONTEXT(interp->ctx)->current_sub = NULL;
 910     CONTEXT(interp->ctx)->constants =
 911         interp->code->const_table->constants;
 912     Parrot_runops_fromc_args(interp, main_sub, "vP", userargv);
 913 }
 914
 915
 916 /*
 917
 918 =item C<opcode_t * Parrot_debug>
 919
 920 Runs the interpreter's bytecode in debugging mode.
 921
 922 =cut
 923
 924 */
 925
 926 PARROT_API
 927 PARROT_CAN_RETURN_NULL
 928 opcode_t *
 929 Parrot_debug(NOTNULL(Parrot_Interp debugger), opcode_t * pc)
 930 {
 931     const char *command;
 932     Interp *interp;
 933
 934     PDB_t * const pdb = debugger->pdb;
 935
 936     pdb->cur_opcode = pc;
 937
 938     PDB_init(debugger, NULL);
 939     /* disassemble needs this for now */
 940     interp = pdb->debugee;
 941     interp->pdb = pdb;
 942     debugger->lo_var_ptr = interp->lo_var_ptr;
 943
 944     PDB_disassemble(interp, NULL);
 945
 946     while (!(pdb->state & PDB_EXIT)) {
 947         PDB_get_command(debugger);
 948         command = pdb->cur_command;
 949         PDB_run_command(debugger, command);
 950     }
 951     return NULL;
 952 }
 953
 954 /*
 955
 956 =item C<void Parrot_disassemble>
 957
 958 Disassembles and prints out the interpreter's bytecode.
 959
 960 This is used by the Parrot disassembler.
 961
 962 =cut
 963
 964 */
 965
 966 PARROT_API
 967 void
 968 Parrot_disassemble(PARROT_INTERP)
 969 {
 970     PDB_t      *pdb             = mem_allocate_zeroed_typed(PDB_t);
 971     PDB_line_t *line;
 972     int         debugs;
 973     int         num_mappings    = 0;
 974     int         curr_mapping    = 0;
 975     int         op_code_seq_num = 0;
 976
 977     interp->pdb     = pdb;
 978     pdb->cur_opcode = interp->code->base.data;
 979
 980     PDB_disassemble(interp, NULL);
 981
 982     line   = pdb->file->line;
 983     debugs = (interp->code->debugs != NULL);
 984
 985     PIO_printf(interp, "%12s-%12s", "Seq_Op_Num", "Relative-PC");
 986
 987     if (debugs) {
 988         PIO_printf(interp, " %6s:\n", "SrcLn#");
 989         num_mappings = interp->code->debugs->num_mappings;
 990     }
 991     else {
 992         PIO_printf(interp, "\n");
 993     }
 994
 995     while (line->next) {
 996         const char *c;
 997
 998         /* PIO_printf(interp, "%i < %i %i == %i \n", curr_mapping,
 999          * num_mappings, op_code_seq_num,
1000          * interp->code->debugs->mappings[curr_mapping]->offset); */
1001
1002         if (debugs && curr_mapping < num_mappings) {
1003             if (op_code_seq_num == interp->code->debugs->mappings[curr_mapping]->offset) {
1004                 const int filename_const_offset =
1005                     interp->code->debugs->mappings[curr_mapping]->u.filename;
1006                 PIO_printf(interp, "Current Source Filename %Ss\n",
1007                         interp->code->const_table->constants[filename_const_offset]->u.string);
1008                 curr_mapping++;
1009             }
1010         }
1011
1012         PIO_printf(interp, "%012i-%012i", op_code_seq_num, line->opcode - interp->code->base.data);
1013
1014         if (debugs)
1015             PIO_printf(interp, " %06i: ", interp->code->debugs->base.data[op_code_seq_num]);
1016
1017         /* If it has a label print it */
1018         if (line->label)
1019             PIO_printf(interp, "L%li:\t", line->label->number);
1020         else
1021             PIO_printf(interp, "\t");
1022
1023         c = pdb->file->source + line->source_offset;
1024
1025         while (c && *c != '\n')
1026             PIO_printf(interp, "%c", *(c++));
1027
1028         PIO_printf(interp, "\n");
1029         line = line->next;
1030         op_code_seq_num++;
1031     }
1032
1033     return;
1034 }
1035
1036 /*
1037
1038 =item C<void Parrot_run_native>
1039
1040 Run the C function C<func> through the program C<[enternative, end]>.
1041 This ensures that the function is run with the same setup as in other
1042 run loops.
1043
1044 This function is used in some of the source tests in F<t/src> which use
1045 the interpreter outside a runloop.
1046
1047 =cut
1048
1049 */
1050
1051 PARROT_API
1052 void
1053 Parrot_run_native(PARROT_INTERP, native_func_t func)
1054 {
1055     static opcode_t program_code[2];
1056     PackFile *          pf;
1057
1058     program_code[0] = interp->op_lib->op_code("enternative", 0);
1059     program_code[1] = 0; /* end */
1060     pf = PackFile_new(interp, 0);
1061     pf->cur_cs = (PackFile_ByteCode *)
1062         (pf->PackFuncs[PF_BYTEC_SEG].new_seg)(interp, pf, "code", 1);
1063     pf->cur_cs->base.data = program_code;
1064     pf->cur_cs->base.size = 2;
1065     Parrot_loadbc(interp, pf);
1066     run_native = func;
1067     if (interp->code && interp->code->const_table) {
1068         CONTEXT(interp->ctx)->constants =
1069             interp->code->const_table->constants;
1070     }
1071     runops(interp, interp->resume_offset);
1072 }
1073
1074 /*
1075
1076 =back
1077
1078 =head1 SEE ALSO
1079
1080 F<include/parrot/embed.h> and F<docs/embed.pod>.
1081
1082 =head1 HISTORY
1083
1084 Initial version by Brent Dax on 2002.1.28.
1085
1086 =cut
1087
1088 */
1089
1090
1091 /*
1092  * Local variables:
1093  *   c-file-style: "parrot"
1094  * End:
1095  * vim: expandtab shiftwidth=4:
1096  */