src/inter_create.c

   1 /*
   2 Copyright (C) 2001-2008, The Perl Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 src/inter_create.c - Parrot Interpreter Creation and Destruction
   8
   9 =head1 DESCRIPTION
  10
  11 Create or destroy a Parrot interpreter
  12
  13 =head2 Functions
  14
  15 =over 4
  16
  17 =cut
  18
  19 */
  20
  21
  22 #include "parrot/parrot.h"
  23 #include "parrot/oplib/core_ops.h"
  24 #include "../compilers/imcc/imc.h"
  25 #include "inter_create.str"
  26
  27 /* HEADERIZER HFILE: include/parrot/interpreter.h */
  28
  29 /* HEADERIZER BEGIN: static */
  30 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
  31
  32 PARROT_WARN_UNUSED_RESULT
  33 static int is_env_var_set(ARGIN(const char* var))
  34         __attribute__nonnull__(1);
  35
  36 static void setup_default_compreg(PARROT_INTERP)
  37         __attribute__nonnull__(1);
  38
  39 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
  40 /* HEADERIZER END: static */
  41
  42 #if EXEC_CAPABLE
  43     extern int Parrot_exec_run;
  44 #endif
  45
  46 #if EXEC_CAPABLE
  47 Interp interpre;
  48 #endif
  49
  50 #define ATEXIT_DESTROY
  51
  52 /*
  53
  54 =item C<static int is_env_var_set>
  55
  56 Checks whether the specified environment variable is set.
  57
  58 =cut
  59
  60 */
  61
  62 PARROT_WARN_UNUSED_RESULT
  63 static int
  64 is_env_var_set(ARGIN(const char* var))
  65 {
  66     int free_it, retval;
  67     char* const value = Parrot_getenv(var, &free_it);
  68     if (value == NULL)
  69         retval = 0;
  70     else if (*value == '\0')
  71         retval = 0;
  72     else
  73         retval = !STREQ(value, "0");
  74     if (free_it)
  75         mem_sys_free(value);
  76     return retval;
  77 }
  78
  79 /*
  80
  81 =item C<static void setup_default_compreg>
  82
  83 Setup default compiler for PASM.
  84
  85 =cut
  86
  87 */
  88
  89 static void
  90 setup_default_compreg(PARROT_INTERP)
  91 {
  92     STRING * const pasm1 = CONST_STRING(interp, "PASM1");
  93
  94     /* register the nci compiler object */
  95     Parrot_compreg(interp, pasm1, (Parrot_compiler_func_t)PDB_compile);
  96 }
  97
  98 /*
  99
 100 =item C<Parrot_Interp make_interpreter>
 101
 102 Create the Parrot interpreter. Allocate memory and clear the registers.
 103
 104 =cut
 105
 106 */
 107
 108 PARROT_API
 109 PARROT_CANNOT_RETURN_NULL
 110 Parrot_Interp
 111 make_interpreter(ARGIN_NULLOK(Interp *parent), INTVAL flags)
 112 {
 113     Interp *interp;
 114
 115     /* Get an empty interpreter from system memory */
 116 #if EXEC_CAPABLE
 117     if (Parrot_exec_run)
 118         interp = &interpre;
 119     else
 120 #endif
 121         interp = mem_allocate_zeroed_typed(Interp);
 122
 123     interp->lo_var_ptr = NULL;
 124
 125     /* the last interpreter (w/o) parent has to cleanup globals
 126      * so remember parent if any */
 127     if (parent)
 128         interp->parent_interpreter = parent;
 129     else {
 130         interp->parent_interpreter = NULL;
 131         PMCNULL                    = NULL;
 132         /*
 133          * we need a global mutex to protect the interpreter array
 134          */
 135         MUTEX_INIT(interpreter_array_mutex);
 136     }
 137
 138     create_initial_context(interp);
 139     interp->resume_flag = RESUME_INITIAL;
 140
 141     /* main is called as a Sub too - this will get depth 0 then */
 142     CONTEXT(interp)->recursion_depth = (UINTVAL)-1;
 143     interp->recursion_limit = RECURSION_LIMIT;
 144
 145     /* Must initialize flags here so the GC_DEBUG stuff is available before
 146      * mem_setup_allocator() is called. */
 147     interp->flags = flags;
 148
 149     /* PANIC will fail until this is done */
 150     interp->piodata = NULL;
 151     PIO_init(interp);
 152
 153     if (is_env_var_set("PARROT_GC_DEBUG")) {
 154 #if ! DISABLE_GC_DEBUG
 155         Interp_flags_SET(interp, PARROT_GC_DEBUG_FLAG);
 156 #else
 157         fprintf(stderr, "PARROT_GC_DEBUG is set but the binary was compiled "
 158                 "with DISABLE_GC_DEBUG.\n");
 159 #endif
 160     }
 161
 162     /* Set up the memory allocation system */
 163     mem_setup_allocator(interp);
 164     Parrot_block_GC_mark(interp);
 165     Parrot_block_GC_sweep(interp);
 166
 167     /*
 168      * Set up the string subsystem
 169      * This also generates the constant string tables
 170      */
 171     string_init(interp);
 172
 173     /* Set up the MMD struct */
 174     interp->binop_mmd_funcs = NULL;
 175
 176     /* Go and init the MMD tables */
 177     mmd_add_function(interp, MMD_USER_FIRST - 1, (funcptr_t)NULL);
 178
 179     /* create caches structure */
 180     init_object_cache(interp);
 181
 182     /* initialize classes - this needs mmd func table */
 183     interp->HLL_info = NULL;
 184     init_world_once(interp);
 185
 186     /* context data */
 187     /* Initialize interpreter's flags */
 188     PARROT_WARNINGS_off(interp, PARROT_WARNINGS_ALL_FLAG);
 189
 190     /* same with errors */
 191     PARROT_ERRORS_off(interp, PARROT_ERRORS_ALL_FLAG);
 192
 193     /* undefined globals are errors by default */
 194     PARROT_ERRORS_on(interp, PARROT_ERRORS_GLOBALS_FLAG);
 195
 196     /* param count mismatch is an error by default */
 197     PARROT_ERRORS_on(interp, PARROT_ERRORS_PARAM_COUNT_FLAG);
 198
 199 #if 0
 200     /* TODO not yet - too many test failures */
 201     PARROT_ERRORS_on(interp, PARROT_ERRORS_RESULT_COUNT_FLAG);
 202 #endif
 203
 204     /* allocate stack chunk cache */
 205     stack_system_init(interp);
 206
 207     /* And a dynamic environment stack */
 208     interp->dynamic_env = new_stack(interp, "DynamicEnv");
 209
 210     /* clear context introspection vars */
 211     CONTEXT(interp)->current_sub    = NULL;
 212     CONTEXT(interp)->current_cont   = NULL;
 213     CONTEXT(interp)->current_object = NULL;
 214
 215     /* Load the core op func and info tables */
 216     interp->op_lib          = PARROT_CORE_OPLIB_INIT(1);
 217     interp->op_count        = interp->op_lib->op_count;
 218     interp->op_func_table   = interp->op_lib->op_func_table;
 219     interp->op_info_table   = interp->op_lib->op_info_table;
 220     interp->all_op_libs     = NULL;
 221     interp->evc_func_table  = NULL;
 222     interp->save_func_table = NULL;
 223     interp->code            = NULL;
 224     interp->profile         = NULL;
 225
 226     /* create the root set registry */
 227     interp->DOD_registry    = pmc_new(interp, enum_class_AddrRegistry);
 228
 229     /* create exceptions list */
 230     interp->current_runloop_id    = 0;
 231     interp->current_runloop_level = 0;
 232
 233     /* register assembler/compilers */
 234     setup_default_compreg(interp);
 235
 236     /* setup stdio PMCs */
 237     PIO_init(interp);
 238
 239     /* init IMCC compiler */
 240     imcc_init(interp);
 241
 242     /* Done. Return and be done with it */
 243
 244     /* Okay, we've finished doing anything that might trigger GC.
 245      * Actually, we could enable DOD/GC earlier, but here all setup is
 246      * done
 247      */
 248     Parrot_unblock_GC_mark(interp);
 249     Parrot_unblock_GC_sweep(interp);
 250
 251     /* all sys running, init the event and signal stuff
 252      * the first or "master" interpreter is handling events and signals
 253      */
 254     interp->task_queue  = NULL;
 255     interp->thread_data = NULL;
 256
 257     Parrot_cx_init_scheduler(interp);
 258
 259 #ifdef ATEXIT_DESTROY
 260     /*
 261      * if this is not a threaded interpreter, push the interpreter
 262      * destruction.
 263      * Threaded interpreters are destructed when the thread ends
 264      */
 265     if (!Interp_flags_TEST(interp, PARROT_IS_THREAD))
 266         Parrot_on_exit(interp, Parrot_really_destroy, NULL);
 267 #endif
 268
 269     return interp;
 270 }
 271
 272 /*
 273
 274 =item C<void Parrot_destroy>
 275
 276 Does nothing if C<ATEXIT_DESTROY> is defined. Otherwise calls
 277 C<Parrot_really_destroy()> with exit code 0.
 278
 279 This function is not currently used.
 280
 281 =cut
 282
 283 */
 284
 285 PARROT_API
 286 void
 287 Parrot_destroy(PARROT_INTERP)
 288 {
 289 #ifdef ATEXIT_DESTROY
 290     UNUSED(interp);
 291 #else
 292     Parrot_really_destroy(interp, 0);
 293 #endif
 294 }
 295
 296 /*
 297
 298 =item C<void Parrot_really_destroy>
 299
 300 Waits for any threads to complete, then frees all allocated memory, and
 301 closes any open file handles, etc.
 302
 303 Note that C<exit_code> is ignored.
 304
 305 =cut
 306
 307 */
 308
 309 void
 310 Parrot_really_destroy(PARROT_INTERP, SHIM(int exit_code), SHIM(void *arg))
 311 {
 312
 313     /*
 314      * wait for threads to complete if needed; terminate the event loop
 315      */
 316     if (!interp->parent_interpreter) {
 317         Parrot_cx_runloop_end(interp);
 318         pt_join_threads(interp);
 319     }
 320
 321     /* if something needs destruction (e.g. closing PIOs)
 322      * we must destroy it now:
 323      *
 324      * Be sure that an async collector hasn't live bits set now, so
 325      * trigger a finish run
 326      *
 327      * Need to turn off DOD blocking, else things stay alive and IO
 328      * handles aren't closed
 329      */
 330     interp->arena_base->DOD_block_level =
 331         interp->arena_base->GC_block_level = 0;
 332
 333     if (Interp_trace_TEST(interp, ~0)) {
 334         PIO_eprintf(interp, "ParrotIO objects (like stdout and stderr)"
 335             "are about to be closed, so clearing trace flags.\n");
 336         Interp_trace_CLEAR(interp, ~0);
 337     }
 338
 339     /* Destroys all PMCs, even constants and the ParrotIO objects for
 340      * std{in, out, err}, so don't be verbose about DOD'ing. */
 341     if (interp->thread_data)
 342         interp->thread_data->state |= THREAD_STATE_SUSPENDED_GC;
 343
 344     Parrot_do_dod_run(interp, GC_finish_FLAG);
 345
 346 #if STM_PROFILE
 347     if (interp->thread_data && interp->thread_data->stm_log &&
 348             !interp->parent_interpreter &&
 349                 Interp_debug_TEST(interp, PARROT_THREAD_DEBUG_FLAG))
 350         Parrot_STM_dump_profile(interp);
 351 #endif
 352
 353     /*
 354      * that doesn't get rid of constant PMCs like these in vtable->data
 355      * so if such a PMC needs destroying, we get a memory leak, like for
 356      * the SharedRef PMC
 357      * TODO sweep constants too or special treatment - depends on how
 358      *      many constant PMCs we'll create
 359      */
 360
 361     /* destroy IMCC compiler */
 362     imcc_destroy(interp);
 363
 364     /* Now the PIOData gets also cleared */
 365     PIO_finish(interp);
 366
 367     /*
 368      * now all objects that need timely destruction should be finalized
 369      * so terminate the event loop
 370      */
 371     if (!interp->parent_interpreter) {
 372         PIO_internal_shutdown(interp);
 373 /*        Parrot_kill_event_loop(interp); */
 374     }
 375
 376     /* we destroy all child interpreters and the last one too,
 377      * if the --leak-test commandline was given
 378      */
 379     if (! (interp->parent_interpreter ||
 380                 Interp_flags_TEST(interp, PARROT_DESTROY_FLAG)))
 381         return;
 382
 383     if (interp->thread_data && interp->thread_data->stm_log) {
 384         while (Parrot_STM_transaction_depth(interp) > 0) {
 385             /* XXX */
 386             fprintf(stderr, "interpreter %p had pending transaction on exit\n",
 387                     (void *) interp);
 388             Parrot_STM_abort(interp);
 389         }
 390 #if STM_PROFILE
 391         if (interp->parent_interpreter
 392             && interp->thread_data->state & THREAD_STATE_JOINED)
 393             Parrot_STM_merge_profile(interp->parent_interpreter,
 394                                      interp);
 395 #endif
 396         Parrot_STM_destroy(interp);
 397     }
 398
 399     if (interp->parent_interpreter &&
 400         interp->thread_data &&
 401         (interp->thread_data->state & THREAD_STATE_JOINED)) {
 402         Parrot_merge_header_pools(interp->parent_interpreter, interp);
 403         Parrot_merge_memory_pools(interp->parent_interpreter, interp);
 404     }
 405
 406     if (interp->arena_base->finalize_gc_system)
 407         interp->arena_base->finalize_gc_system(interp);
 408
 409     /* copies of constant tables */
 410     Parrot_destroy_constants(interp);
 411
 412     /* buffer headers, PMCs */
 413     Parrot_destroy_header_pools(interp);
 414
 415     /* memory pools in resources */
 416     Parrot_destroy_memory_pools(interp);
 417
 418     /* mem subsystem is dead now */
 419     mem_sys_free(interp->arena_base);
 420     interp->arena_base = NULL;
 421
 422     /* cache structure */
 423     destroy_object_cache(interp);
 424
 425     /* packfile */
 426     if (interp->initial_pf)
 427         PackFile_destroy(interp, interp->initial_pf);
 428
 429     if (interp->profile) {
 430         mem_sys_free(interp->profile->data);
 431         interp->profile->data = NULL;
 432         mem_sys_free(interp->profile);
 433         interp->profile = NULL;
 434     }
 435
 436     /* deinit op_lib */
 437     (void) PARROT_CORE_OPLIB_INIT(0);
 438
 439     stack_destroy(interp->dynamic_env);
 440
 441     destroy_context(interp);
 442     destroy_runloop_jump_points(interp);
 443
 444     if (interp->evc_func_table) {
 445         mem_sys_free(interp->evc_func_table);
 446         interp->evc_func_table = NULL;
 447     }
 448
 449     /* strings, charsets, encodings - only once */
 450     string_deinit(interp);
 451
 452     if (!interp->parent_interpreter) {
 453         if (interp->thread_data)
 454             mem_sys_free(interp->thread_data);
 455
 456         /* free vtables */
 457         parrot_free_vtables(interp);
 458         mmd_destroy(interp);
 459
 460         MUTEX_DESTROY(interpreter_array_mutex);
 461         mem_sys_free(interp);
 462         /*
 463          * finally free other globals
 464          */
 465         mem_sys_free(interpreter_array);
 466         interpreter_array = NULL;
 467     }
 468
 469     else {
 470         /* don't free a thread interpreter, if it isn't joined yet */
 471         if (!interp->thread_data || (
 472                     interp->thread_data &&
 473                     (interp->thread_data->state & THREAD_STATE_JOINED))) {
 474             if (interp->thread_data) {
 475                 mem_sys_free(interp->thread_data);
 476                 interp->thread_data = NULL;
 477             }
 478             mem_sys_free(interp);
 479         }
 480     }
 481 }
 482
 483 /*
 484
 485 =back
 486
 487 =head1 SEE ALSO
 488
 489 F<include/parrot/interpreter.h>, F<src/interpreter.c>.
 490
 491 =cut
 492
 493 */
 494
 495 /*
 496  * Local variables:
 497  *   c-file-style: "parrot"
 498  * End:
 499  * vim: expandtab shiftwidth=4:
 500  */