static void
setup_argv(struct Parrot_Interp *interpreter, int argc, char ** argv)
{
INTVAL i;
PMC *userargv;
if (Interp_flags_TEST(interpreter, PARROT_DEBUG_FLAG)) {
PIO_eprintf(interpreter,
"*** Parrot VM: Setting up ARGV array in P5. Current argc: %d ***\n",
argc);
}
userargv = pmc_new_noinit(interpreter, enum_class_SArray);
/* immediately anchor pmc to root set */
interpreter->pmc_reg.registers[5] = userargv;
VTABLE_set_pmc_keyed_int(interpreter, interpreter->iglobals,
(INTVAL)IGLOBALS_ARGV_LIST, userargv);
VTABLE_init(interpreter, userargv);
VTABLE_set_integer_native(interpreter, userargv, argc);
for (i = 0; i < argc; i++) {
/* Run through argv, adding everything to @ARGS. */
STRING *arg = string_make(interpreter, argv[i], strlen(argv[i]),
0, PObj_external_FLAG, 0);
if (Interp_flags_TEST(interpreter, PARROT_DEBUG_FLAG)) {
PIO_eprintf(interpreter, "\t%vd: %s\n", i, argv[i]);
}
VTABLE_push_string(interpreter, userargv, arg);
}
}
static void
print_debug(int status, void *p)
{
Parrot_Interp interpreter = (Parrot_Interp) p;
if (Interp_flags_TEST(interpreter, PARROT_DEBUG_FLAG)) {
/* Give the souls brave enough to activate debugging an earful
* about GC. */
PIO_eprintf(interpreter, "*** Parrot VM: Dumping GC info ***\n");
PDB_info(interpreter);
}
}
void
Parrot_runcode(struct Parrot_Interp *interpreter, int argc, char *argv[])
{
/* Debugging mode nonsense. */
if (Interp_flags_TEST(interpreter, PARROT_DEBUG_FLAG)) {
if (Interp_flags_TEST(interpreter, PARROT_BOUNDS_FLAG)) {
PIO_eprintf(interpreter,
"*** Parrot VM: Bounds checking enabled. ***\n");
}
if (Interp_flags_TEST(interpreter, PARROT_TRACE_FLAG)) {
PIO_eprintf(interpreter, "*** Parrot VM: Tracing enabled. ***\n");
}
PIO_eprintf(interpreter, "*** Parrot VM: ");
switch (interpreter->run_core) {
case PARROT_SLOW_CORE:
PIO_eprintf(interpreter, "Slow core");
break;
case PARROT_FAST_CORE:
PIO_eprintf(interpreter, "Fast core");
break;
case PARROT_PREDEREF_CORE:
PIO_eprintf(interpreter, "Predereferencing core");
break;
case PARROT_SWITCH_CORE:
PIO_eprintf(interpreter, "Switch core");
break;
case PARROT_CGP_CORE:
PIO_eprintf(interpreter, "CGP core");
break;
case PARROT_CGOTO_CORE:
PIO_eprintf(interpreter, "CGoto core");
break;
case PARROT_JIT_CORE:
PIO_eprintf(interpreter, "JIT core");
break;
case PARROT_EXEC_CORE:
PIO_eprintf(interpreter, "EXEC core");
break;
}
PIO_eprintf(interpreter, " ***\n");
}
/* Set up @ARGS (or whatever this language calls it).
XXX Should this be Array or PerlArray? */
setup_argv(interpreter, argc, argv);
#if EXEC_CAPABLE
/* s. runops_exec interpreter.c */
if (Interp_core_TEST(interpreter, PARROT_EXEC_CORE)) {
extern int Parrot_exec_run;
Parrot_exec_run = 1;
}
#endif
/*
* If any profile information was gathered, print it out
* before exiting, then print debug infos if turned on
*/
Parrot_on_exit(print_debug, interpreter);
Parrot_on_exit(print_profile, interpreter);
/* Let's kick the tires and light the fires--call interpreter.c:runops. */
runops(interpreter, interpreter->resume_offset);
}
Parrot_Int
Parrot_test_flag(Parrot_Interp interpreter, Parrot_Interp_flag flag)
{
return Interp_flags_TEST(interpreter, flag);
}
PARROT_EXPORT
Parrot_Int
Parrot_test_flag(PARROT_INTERP, INTVAL flag)
{
return Interp_flags_TEST(interp, flag);
}
opcode_t *
runops_slow_core(struct Parrot_Interp *interpreter, opcode_t *pc)
{
#ifdef USE_TRACE_INTERP
Interp * trace_i;
struct Parrot_Context *trace_ctx;
#endif
opcode_t *opc, *ostart, *oend;
static size_t dod, gc;
#ifdef code_start
# undef code_start
#endif
#ifdef code_end
# undef code_end
#endif
#define code_start interpreter->code->byte_code
#define code_end (interpreter->code->byte_code + \
interpreter->code->cur_cs->base.size)
#ifdef USE_TRACE_INTERP
if (Interp_flags_TEST(interpreter, PARROT_TRACE_FLAG)) {
trace_i = make_interpreter(interpreter, NO_FLAGS);
Parrot_init(trace_i);
/* remeber old context */
trace_ctx = mem_sys_allocate(sizeof(struct Parrot_Context));
mem_sys_memcopy(trace_ctx, &trace_i->ctx,
sizeof(struct Parrot_Context));
/* copy in current */
mem_sys_memcopy(&trace_i->ctx, &interpreter->ctx,
sizeof(struct Parrot_Context));
trace_i->code = interpreter->code;
Interp_flags_SET(trace_i, PARROT_EXTERN_CODE_FLAG);
}
#endif
dod = interpreter->dod_runs;
gc = interpreter->collect_runs;
while (pc) {/* && pc >= code_start && pc < code_end) {*/
interpreter->cur_pc = pc;
opc = pc;
ostart = code_start;
oend = code_end;
DO_OP(pc, interpreter);
if (Interp_flags_TEST(interpreter, PARROT_TRACE_FLAG)) {
#ifdef USE_TRACE_INTERP
mem_sys_memcopy(&trace_i->ctx, &interpreter->ctx,
sizeof(struct Parrot_Context));
trace_op(trace_i, ostart, oend, opc);
#else
trace_op(interpreter, ostart, oend, opc);
#endif
if (dod != interpreter->dod_runs) {
dod = interpreter->dod_runs;
PIO_printf(interpreter, " DOD\n");
}
if (gc != interpreter->collect_runs) {
gc = interpreter->collect_runs;
PIO_printf(interpreter, " GC\n");
}
}
}
#ifdef USE_TRACE_INTERP
if (Interp_flags_TEST(interpreter, PARROT_TRACE_FLAG)) {
/* restore trace context */
mem_sys_memcopy(&trace_i->ctx, trace_ctx,
sizeof(struct Parrot_Context));
mem_sys_free(trace_ctx);
}
#endif
/* if (pc && (pc < code_start || pc >= code_end)) {
internal_exception(INTERP_ERROR,
"Error: Control left bounds of byte-code block (now at location %d)!\n",
(int)(pc - code_start));
}*/
#undef code_start
#undef code_end
return pc;
}
