1 /*
2 Copyright (C) 2001-2015, Parrot Foundation.
3
4 =head1 NAME
5
6 src/interp/api.c - Parrot Interpreter API
7
8 =head1 DESCRIPTION
9
10 Functions related to managing the Parrot interpreter
11
12 =head2 Functions
13
14 =over 4
15
16 =cut
17
18 */
19
20 #include "parrot/parrot.h"
21 #include "parrot/runcore_api.h"
22 #include "parrot/oplib/core_ops.h"
23 #include "pmc/pmc_callcontext.h"
24 #include "../gc/gc_private.h"
25 #include "api.str"
26 #include "pmc/pmc_parrotinterpreter.h"
27 #include "parrot/has_header.h"
28 #include "imcc/embed.h"
29 #include "parrot/thread.h"
30
31 #ifdef PARROT_HAS_HEADER_SYSUTSNAME
32 # include <sys/utsname.h>
33 #endif
34
35 static Interp* emergency_interp = NULL;
36
37 /* HEADERIZER HFILE: include/parrot/interpreter.h */
38
39 /* HEADERIZER BEGIN: static */
40 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
41
42 PARROT_WARN_UNUSED_RESULT
43 static int Parrot_interp_is_env_var_set(PARROT_INTERP, ARGIN(STRING* var))
44 __attribute__nonnull__(1)
45 __attribute__nonnull__(2);
46
47 #define ASSERT_ARGS_Parrot_interp_is_env_var_set __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
48 PARROT_ASSERT_ARG(interp) \
49 , PARROT_ASSERT_ARG(var))
50 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
51 /* HEADERIZER END: static */
52
53 #define ATEXIT_DESTROY
54
55 /*
56
57 =item C<static int Parrot_interp_is_env_var_set(PARROT_INTERP, STRING* var)>
58
59 Checks whether the specified environment variable is set.
60
61 =cut
62
63 */
64
65 PARROT_WARN_UNUSED_RESULT
66 static int
Parrot_interp_is_env_var_set(PARROT_INTERP,ARGIN (STRING * var))67 Parrot_interp_is_env_var_set(PARROT_INTERP, ARGIN(STRING* var))
68 {
69 ASSERT_ARGS(Parrot_interp_is_env_var_set)
70 int retval;
71 STRING * const value = Parrot_getenv(interp, var);
72 if (STRING_IS_NULL(value))
73 retval = 0;
74 else if (STRING_IS_EMPTY(value))
75 retval = 0;
76 else
77 retval = !STRING_equal(interp, value, CONST_STRING(interp, "0"));
78 return retval;
79 }
80
81 /*
82
83 =item C<Parrot_Interp Parrot_interp_new(Parrot_Interp parent)>
84
85 Returns a new Parrot interpreter.
86
87 The first created interpreter (C<parent> is C<NULL>) is the last one
88 to get destroyed.
89
90 Note that subsequently created interpreters with C<parent> C<NULL>
91 will use the first interpreter as parent.
92
93 =cut
94
95 */
96
97 PARROT_EXPORT
98 PARROT_CANNOT_RETURN_NULL
99 PARROT_MALLOC
100 Parrot_Interp
Parrot_interp_new(ARGIN_NULLOK (Parrot_Interp parent))101 Parrot_interp_new(ARGIN_NULLOK(Parrot_Interp parent))
102 {
103 ASSERT_ARGS(Parrot_interp_new)
104 /* api.c:Parrot_interp_make_interpreter builds a new Parrot_Interp. */
105 return Parrot_interp_make_interpreter(parent, PARROT_NO_FLAGS);
106 }
107
108 /*
109
110 =item C<void Parrot_interp_init_stacktop(PARROT_INTERP, void *stack_top)>
111
112 Initializes the new interpreter when it hasn't been initialized before.
113
114 Additionally sets the stack top, so that Parrot objects created
115 in inner stack frames will be visible during GC stack walking code.
116 B<stack_top> should be the address of an automatic variable in the caller's
117 stack frame. All unanchored Parrot objects (PMCs) must live in inner stack
118 frames so that they are not destroyed during GC runs.
119
120 Use this function when you call into Parrot before entering a run loop.
121
122 =cut
123
124 */
125
126 PARROT_EXPORT
127 void
Parrot_interp_init_stacktop(PARROT_INTERP,ARGIN (void * stack_top))128 Parrot_interp_init_stacktop(PARROT_INTERP, ARGIN(void *stack_top))
129 {
130 ASSERT_ARGS(Parrot_interp_init_stacktop)
131 interp->lo_var_ptr = stack_top;
132 Parrot_gbl_init_world_once(interp);
133 }
134
135 /*
136
137 =item C<Parrot_Interp Parrot_interp_make_interpreter(Interp *parent, INTVAL
138 flags)>
139
140 Create the Parrot interpreter. Allocate memory and clear the registers.
141
142 =cut
143
144 */
145
146 PARROT_EXPORT
147 PARROT_CANNOT_RETURN_NULL
148 PARROT_MALLOC
149 Parrot_Interp
Parrot_interp_make_interpreter(ARGIN_NULLOK (Interp * parent),INTVAL flags)150 Parrot_interp_make_interpreter(ARGIN_NULLOK(Interp *parent), INTVAL flags)
151 {
152 ASSERT_ARGS(Parrot_interp_make_interpreter)
153 int stacktop;
154 Parrot_GC_Init_Args args;
155 Parrot_Interp const interp = Parrot_interp_allocate_interpreter(parent, flags);
156 memset(&args, 0, sizeof (args));
157 args.stacktop = &stacktop;
158 Parrot_interp_initialize_interpreter(interp, &args);
159 return interp;
160 }
161
162 /*
163
164 =item C<Parrot_Interp Parrot_interp_allocate_interpreter(Interp *parent, INTVAL
165 flags)>
166
167 Allocate new interpreter from system memory. Everything is preallocated but not
168 initialized. Used in next cycle:
169
170 allocate_interpreter
171 parseflags
172 Parrot_interp_initialize_interpreter
173
174 for overriding subsystems (e.g. GC) which require early initialization.
175
176 =cut
177
178 */
179
180 PARROT_EXPORT
181 PARROT_CANNOT_RETURN_NULL
182 PARROT_MALLOC
183 Parrot_Interp
Parrot_interp_allocate_interpreter(ARGIN_NULLOK (Interp * parent),INTVAL flags)184 Parrot_interp_allocate_interpreter(ARGIN_NULLOK(Interp *parent), INTVAL flags)
185 {
186 ASSERT_ARGS(Parrot_interp_allocate_interpreter)
187 Interp *interp;
188
189 /* Get an empty interpreter from system memory */
190 interp = mem_internal_allocate_zeroed_typed(Interp);
191
192 /* the last interpreter (w/o) parent has to cleanup globals
193 * so remember parent if any */
194 if (parent)
195 interp->parent_interpreter = parent;
196 else {
197 if (!emergency_interp) {
198 interp->parent_interpreter = NULL;
199 emergency_interp = interp;
200 }
201 #ifdef PARROT_HAS_THREADS
202 else {
203 interp->parent_interpreter = emergency_interp;
204 }
205 #else
206 interp->parent_interpreter = NULL;
207 #endif
208
209 PMCNULL = NULL;
210 }
211
212 /* Must initialize flags before Parrot_gc_initialize() is called
213 * so the GC_DEBUG stuff is available. */
214 interp->flags = flags;
215
216 interp->ctx = NULL;
217 interp->resume_flag = RESUME_INITIAL;
218
219 interp->recursion_limit = RECURSION_LIMIT;
220
221 /* PANIC will fail until this is done */
222 interp->piodata = NULL;
223
224 /* create exceptions list */
225 interp->current_runloop_id = 0;
226 interp->current_runloop_level = 0;
227
228 interp->gc_sys = mem_internal_allocate_zeroed_typed(GC_Subsystem);
229
230 /* Done. Return and be done with it */
231 return interp;
232 }
233
234 /*
235
236 =item C<Parrot_Interp Parrot_interp_initialize_interpreter(PARROT_INTERP,
237 Parrot_GC_Init_Args *args)>
238
239 Initialize previously allocated interpreter.
240
241 =cut
242
243 */
244
245 PARROT_EXPORT
246 PARROT_CANNOT_RETURN_NULL
247 Parrot_Interp
Parrot_interp_initialize_interpreter(PARROT_INTERP,ARGIN (Parrot_GC_Init_Args * args))248 Parrot_interp_initialize_interpreter(PARROT_INTERP, ARGIN(Parrot_GC_Init_Args *args))
249 {
250 ASSERT_ARGS(Parrot_interp_initialize_interpreter)
251
252 /* Set up the memory allocation system */
253 interp->debug_flags = args->debug_flags;
254 Parrot_gc_initialize(interp, args);
255 Parrot_block_GC_mark(interp);
256 Parrot_block_GC_sweep(interp);
257
258 interp->ctx = PMCNULL;
259 interp->resume_flag = RESUME_INITIAL;
260
261 interp->recursion_limit = RECURSION_LIMIT;
262
263 /* PANIC will fail until this is done */
264 interp->piodata = NULL;
265 Parrot_io_init(interp);
266
267 /* use the system time as the prng seed */
268 Parrot_util_srand(Parrot_get_entropy(interp));
269
270 /*
271 * Set up the string subsystem
272 * This also generates the constant string tables
273 */
274 Parrot_str_init(interp);
275
276 /* create caches structure */
277 init_object_cache(interp);
278
279 /* initialize classes - this needs mmd func table */
280 interp->HLL_info = NULL;
281
282 Parrot_vtbl_initialize_core_vtables(interp);
283
284 /* create the root set registry */
285 interp->gc_registry = Parrot_pmc_new(interp, enum_class_AddrRegistry);
286
287 /* Set up MMD; MMD cache for builtins. */
288 interp->op_mmd_cache = Parrot_mmd_cache_create(interp);
289 Parrot_pmc_gc_register(interp, interp->op_mmd_cache);
290
291 Parrot_gbl_init_world_once(interp);
292
293 /* context data */
294 if (Parrot_interp_is_env_var_set(interp, CONST_STRING(interp, "PARROT_GC_DEBUG"))) {
295 #if ! DISABLE_GC_DEBUG
296 Interp_flags_SET(interp, PARROT_GC_DEBUG_FLAG);
297 #else
298 fprintf(stderr, "PARROT_GC_DEBUG is set but the binary was compiled "
299 "with DISABLE_GC_DEBUG.\n");
300 #endif
301 }
302
303 /* Initialize interpreter's flags */
304 PARROT_WARNINGS_off(interp, PARROT_WARNINGS_ALL_FLAG);
305
306 /* same with errors */
307 PARROT_ERRORS_off(interp, PARROT_ERRORS_ALL_FLAG);
308
309 /* param count mismatch is an error by default */
310 PARROT_ERRORS_on(interp, PARROT_ERRORS_PARAM_COUNT_FLAG);
311
312 create_initial_context(interp);
313
314 /* clear context introspection vars */
315 Parrot_pcc_set_sub(interp, CURRENT_CONTEXT(interp), NULL);
316 Parrot_pcc_set_continuation(interp, CURRENT_CONTEXT(interp), NULL); /* TODO Use PMCNULL */
317
318 /* initialize built-in runcores */
319 Parrot_runcore_init(interp);
320
321 /* Load the core op func and info tables */
322 interp->all_op_libs = NULL;
323 interp->evc_func_table = NULL;
324 interp->evc_func_table_size = 0;
325 interp->code = NULL;
326
327 /* create exceptions list */
328 interp->current_runloop_id = 0;
329 interp->current_runloop_level = 0;
330
331 /* setup stdio PMCs */
332 Parrot_io_init(interp);
333
334 /* all sys running, init the threads, event and signal stuff */
335 if (args->numthreads)
336 args->numthreads = Parrot_set_num_threads(interp, args->numthreads);
337 Parrot_cx_init_scheduler(interp);
338
339 #ifdef PARROT_HAS_THREADS
340 interp->wake_up = 0;
341 COND_INIT(interp->sleep_cond);
342 MUTEX_INIT(interp->sleep_mutex);
343 #endif
344
345 /* Done. Return and be done with it */
346
347 /* Okay, we've finished doing anything that might trigger GC.
348 * Actually, we could enable GC earlier, but here all setup is
349 * done
350 */
351 Parrot_unblock_GC_mark(interp);
352 Parrot_unblock_GC_sweep(interp);
353
354 #ifdef ATEXIT_DESTROY
355 /*
356 * if this is not a threaded interpreter, push the interpreter
357 * destruction.
358 * Threaded interpreters are destructed when the thread ends
359 */
360 if (!Interp_flags_TEST(interp, PARROT_IS_THREAD))
361 Parrot_x_on_exit(interp, Parrot_interp_really_destroy, NULL);
362 #endif
363
364 return interp;
365 }
366
367 /*
368
369 =item C<PMC * Parrot_interp_clone(PARROT_INTERP, INTVAL flags)>
370
371 Clones the interpreter as specified by the flags.
372
373 TODO: Move this logic into src/interp/api.c or src/threads.c, as appropriate.
374
375 =cut
376
377 */
378
379 PARROT_EXPORT
380 PARROT_CANNOT_RETURN_NULL
381 PMC *
Parrot_interp_clone(PARROT_INTERP,INTVAL flags)382 Parrot_interp_clone(PARROT_INTERP, INTVAL flags)
383 {
384 ASSERT_ARGS(Parrot_interp_clone)
385 /* have to pass a parent to allocate_interpreter to prevent PMCNULL from being set to NULL */
386 Parrot_Interp d = Parrot_interp_allocate_interpreter(interp, flags);
387 int stacktop;
388 Parrot_GC_Init_Args args;
389
390 PMC * interp_pmc;
391 PMC * const config_hash = VTABLE_get_pmc_keyed_int(interp, interp->iglobals,
392 IGLOBALS_CONFIG_HASH);
393
394 memset(&args, 0, sizeof (args));
395 args.stacktop = &stacktop;
396
397 /* Set up the memory allocation system */
398 Parrot_gc_initialize(d, &args);
399 Parrot_block_GC_mark(d);
400 Parrot_block_GC_sweep(d);
401
402 d->ctx = PMCNULL;
403 d->resume_flag = RESUME_INITIAL;
404 d->recursion_limit = RECURSION_LIMIT;
405
406 /* PANIC will fail until this is done */
407 d->piodata = NULL;
408 Parrot_io_init(d);
409
410 /*
411 * Set up the string subsystem
412 * This also generates the constant string tables
413 * Do this before unsetting parent_interpreter to copy its hash_seed and constant string table
414 */
415 Parrot_str_init(d);
416
417 /* create caches structure */
418 init_object_cache(d);
419
420 d->n_vtable_max = interp->n_vtable_max;
421 d->vtables = interp->vtables;
422 d->class_hash = Parrot_thread_create_proxy(interp, d, interp->class_hash);
423
424 Parrot_cx_init_scheduler(d);
425
426 d->parent_interpreter = NULL;
427
428 /* create the root set registry */
429 d->gc_registry = Parrot_pmc_new(d, enum_class_AddrRegistry);
430
431 interp_pmc = Parrot_pmc_new_noinit(d, enum_class_ParrotInterpreter);
432 VTABLE_set_pointer(d, interp_pmc, d);
433
434 /* init the interpreter globals array */
435 d->iglobals = Parrot_pmc_new_init_int(d, enum_class_FixedPMCArray, (INTVAL)IGLOBALS_SIZE);
436
437 VTABLE_set_pmc_keyed_int(d, d->iglobals, (INTVAL) IGLOBALS_INTERPRETER, interp_pmc);
438
439 /* initialize built-in runcores */
440 Parrot_runcore_init(d);
441
442 /* create a proxy for the config_hash */
443 VTABLE_set_pmc_keyed_int(d, d->iglobals, (INTVAL) IGLOBALS_CONFIG_HASH,
444 Parrot_thread_create_proxy(interp, d, config_hash));
445
446 /* can't copy directly, unless you want double-frees */
447 if (flags & PARROT_CLONE_RUNOPS)
448 Parrot_runcore_switch(d, interp->run_core->name);
449
450 if (flags & PARROT_CLONE_INTERP_FLAGS) {
451 /* XXX setting of IS_THREAD? */
452 d->flags = interp->flags;
453 d->debug_flags = interp->debug_flags;
454 }
455
456 d->root_namespace = Parrot_thread_create_proxy(interp, d, interp->root_namespace);
457
458 if (flags & PARROT_CLONE_HLL) {
459 /* we'd like to share the HLL data. Give it a PMC_sync structure
460 if it doesn't have one already */
461
462 /* This used to be proxied:
463
464 d->HLL_info = Parrot_thread_create_proxy(s, d, s->HLL_info);
465
466 But src/hll.c:Parrot_hll_get_HLL_type() pokes directly into the
467 PMC attributes which is a problem if we're using a Proxy. Instead,
468 clone the structure so direct accesses continue working.
469 */
470 d->HLL_info = VTABLE_clone(d, interp->HLL_info);
471 d->HLL_namespace = Parrot_thread_create_proxy(interp, d, interp->HLL_namespace);
472 d->HLL_entries = Parrot_thread_create_proxy(interp, d, interp->HLL_entries);
473 }
474
475 if (flags & (PARROT_CLONE_LIBRARIES | PARROT_CLONE_CLASSES)) {
476 }
477
478 if (flags & PARROT_CLONE_LIBRARIES) {
479 PMC * const pbc_libs = VTABLE_get_pmc_keyed_int(interp, interp->iglobals,
480 IGLOBALS_PBC_LIBS);
481 VTABLE_set_pmc_keyed_int(d, d->iglobals, (INTVAL) IGLOBALS_PBC_LIBS,
482 Parrot_thread_create_proxy(interp, d, pbc_libs));
483 }
484
485 create_initial_context(d);
486
487 if (flags & PARROT_CLONE_CODE)
488 Parrot_clone_code(d, interp);
489
490 /* setup stdio PMCs */
491 Parrot_io_init(d);
492
493 Parrot_unblock_GC_sweep(d);
494 Parrot_unblock_GC_mark(d);
495
496 return interp_pmc;
497 }
498
499 /*
500
501 =item C<PMC * clone_interp(PARROT_INTERP, INTVAL flags)>
502
503 Deprecated: Use C<Parrot_interp_clone> instead. GH #1122
504
505 =cut
506
507 */
508
509 PARROT_EXPORT
510 PARROT_DEPRECATED
511 PARROT_CANNOT_RETURN_NULL
512 PMC *
clone_interp(PARROT_INTERP,INTVAL flags)513 clone_interp(PARROT_INTERP, INTVAL flags)
514 {
515 ASSERT_ARGS(clone_interp)
516 return Parrot_interp_clone(interp, flags);
517 }
518
519 /*
520
521 =item C<void Parrot_interp_destroy(PARROT_INTERP)>
522
523 Does nothing if C<ATEXIT_DESTROY> is defined. Otherwise calls
524 C<Parrot_really_destroy()> with exit code 0.
525
526 This function is not currently used.
527
528 =cut
529
530 */
531
532 PARROT_EXPORT
533 void
Parrot_interp_destroy(PARROT_INTERP)534 Parrot_interp_destroy(PARROT_INTERP)
535 {
536 ASSERT_ARGS(Parrot_interp_destroy)
537
538 #ifndef ATEXIT_DESTROY
539 Parrot_interp_really_destroy(interp, 0);
540 #else
541 UNUSED(interp)
542 #endif
543 }
544
545 /*
546
547 =item C<void Parrot_interp_really_destroy(PARROT_INTERP, int exit_code, void
548 *arg)>
549
550 Waits for any threads to complete, then frees all allocated memory, and
551 closes any open file handles, etc.
552
553 The arguments C<exit_code> and C<arg> are currently ignored.
554
555 =cut
556
557 */
558
559 void
Parrot_interp_really_destroy(PARROT_INTERP,SHIM (int exit_code),SHIM (void * arg))560 Parrot_interp_really_destroy(PARROT_INTERP, SHIM(int exit_code), SHIM(void *arg))
561 {
562 ASSERT_ARGS(Parrot_interp_really_destroy)
563
564 if (!interp->parent_interpreter) {
565 /* Don't bother trying to provide a pir backtrace on assertion failures
566 * during global destruction. It only works in movies. */
567 Parrot_interp_clear_emergency_interpreter();
568 }
569
570 /* if something needs destruction (e.g. closing PIOs)
571 * we must destroy it now:
572 *
573 * Be sure that an async collector hasn't live bits set now, so
574 * trigger a finish run
575 *
576 * Need to turn off GC blocking, else things stay alive and IO
577 * handles aren't closed
578 */
579 Parrot_gc_completely_unblock(interp);
580
581 if (Interp_trace_TEST(interp, ~0)) {
582 Parrot_io_eprintf(interp, "FileHandle objects (like stdout and stderr)"
583 "are about to be closed, so clearing trace flags.\n");
584 Interp_trace_CLEAR(interp, ~0);
585 }
586
587 /*
588 * that doesn't get rid of constant PMCs like these in vtable->data
589 * so if such a PMC needs destroying, we get a memory leak, like for
590 * the SharedRef PMC
591 * TODO sweep constants too or special treatment - depends on how
592 * many constant PMCs we'll create
593 */
594
595 /* Now the PIOData gets also cleared */
596 Parrot_io_finish(interp);
597
598 /* deinit runcores and dynamic op_libs */
599 if (!interp->parent_interpreter)
600 Parrot_runcore_destroy(interp);
601
602 /*
603 * now all objects that need timely destruction should be finalized
604 * so terminate the event loop.
605 */
606 #if 0
607 if (!interp->parent_interpreter) {
608 PIO_internal_shutdown(interp);
609 Parrot_kill_event_loop(interp);
610 }
611 #endif
612
613 /* we destroy all child interpreters and the last one too,
614 * if the --leak-test commandline was given, and there is no
615 * pending exception. */
616 if (! (interp->parent_interpreter)
617 || (Interp_flags_TEST(interp, PARROT_DESTROY_FLAG)
618 && !PMC_IS_NULL(interp->final_exception)))
619 return;
620
621 if (interp->parent_interpreter)
622 Parrot_gc_destroy_child_interp(interp->parent_interpreter, interp);
623
624 Parrot_gc_mark_and_sweep(interp, GC_finish_FLAG);
625
626 destroy_runloop_jump_points(interp);
627
628 /* cache structure */
629 destroy_object_cache(interp);
630
631 if (interp->evc_func_table) {
632 mem_gc_free(interp, interp->evc_func_table);
633 interp->evc_func_table = NULL;
634 interp->evc_func_table_size = 0;
635 }
636
637 /* strings, encodings - only once */
638 Parrot_str_finish(interp);
639
640 PARROT_CORE_OPLIB_INIT(interp, 0);
641
642 if (!interp->parent_interpreter) {
643 /* get rid of ops */
644 if (interp->op_hash)
645 Parrot_hash_destroy(interp, interp->op_hash);
646
647 /* free vtables */
648 Parrot_vtbl_free_vtables(interp);
649
650 /* Finalize GC */
651 Parrot_gc_finalize(interp);
652
653 mem_internal_free(interp);
654 }
655
656 else {
657 Parrot_vtbl_free_vtables(interp);
658
659 /* Finalize GC */
660 Parrot_gc_finalize(interp);
661 mem_internal_free(interp);
662 }
663 }
664
665
666 /*
667
668 =item C<Interp* Parrot_interp_get_emergency_interpreter(void)>
669
670 Provide access to a (possibly) valid interp pointer. This is intended B<only>
671 for use cases when an interp is not available otherwise, which shouldn't be
672 often. There are no guarantees about what this function returns. If you
673 have access to a valid interp, use that instead. Don't use this for anything
674 other than error handling.
675
676 =cut
677
678 */
679
680 PARROT_CAN_RETURN_NULL
681 Interp*
Parrot_interp_get_emergency_interpreter(void)682 Parrot_interp_get_emergency_interpreter(void)
683 {
684 ASSERT_ARGS(Parrot_interp_get_emergency_interpreter)
685 return emergency_interp;
686 }
687
688 /*
689
690 =item C<void Parrot_interp_clear_emergency_interpreter(void)>
691
692 Null the C<emergency_interp> static variable. This is only useful when
693 purposefully invalidating C<emergency_interp>. This is not a general-purpose
694 function. Don't use it for anything other than error handling.
695
696 =cut
697
698 */
699
700 void
Parrot_interp_clear_emergency_interpreter(void)701 Parrot_interp_clear_emergency_interpreter(void)
702 {
703 ASSERT_ARGS(Parrot_interp_clear_emergency_interpreter)
704 emergency_interp = NULL;
705 }
706
707
708
709 /*
710
711 =item C<void Parrot_interp_register_nci_method(PARROT_INTERP, const int type,
712 void *func, const char *name, const char *proto)>
713
714 Create an entry in the C<nci_method_table> for the given NCI method of PMC
715 class C<type>.
716
717 =cut
718
719 */
720
721 PARROT_EXPORT
722 void
Parrot_interp_register_nci_method(PARROT_INTERP,const int type,ARGIN (void * func),ARGIN (const char * name),ARGIN (const char * proto))723 Parrot_interp_register_nci_method(PARROT_INTERP, const int type, ARGIN(void *func),
724 ARGIN(const char *name), ARGIN(const char *proto))
725 {
726 ASSERT_ARGS(Parrot_interp_register_nci_method)
727 PMC * const method = Parrot_pmc_new(interp, enum_class_NCI);
728 STRING * const method_name = Parrot_str_new_init(interp, name, strlen(name),
729 Parrot_default_encoding_ptr, PObj_constant_FLAG|PObj_external_FLAG);
730
731 /* create call func */
732 VTABLE_set_pointer_keyed_str(interp, method,
733 Parrot_str_new_init(interp, proto, strlen(proto),
734 Parrot_default_encoding_ptr, PObj_constant_FLAG|PObj_external_FLAG),
735 func);
736
737 /* insert it into namespace */
738 VTABLE_set_pmc_keyed_str(interp, interp->vtables[type]->_namespace,
739 method_name, method);
740 }
741
742 /*
743
744 =item C<void Parrot_interp_register_native_pcc_method_in_ns(PARROT_INTERP, const
745 int type, void *func, STRING *name, STRING *signature)>
746
747 Create an entry in the C<nci_method_table> for the given raw NCI method
748 of PMC class C<type>.
749
750 =cut
751
752 */
753
754 PARROT_EXPORT
755 void
Parrot_interp_register_native_pcc_method_in_ns(PARROT_INTERP,const int type,ARGIN (void * func),ARGIN (STRING * name),ARGIN (STRING * signature))756 Parrot_interp_register_native_pcc_method_in_ns(PARROT_INTERP, const int type, ARGIN(void *func),
757 ARGIN(STRING *name), ARGIN(STRING *signature))
758 {
759 ASSERT_ARGS(Parrot_interp_register_native_pcc_method_in_ns)
760 PMC * method = Parrot_pmc_new(interp, enum_class_NativePCCMethod);
761
762 /* setup call func */
763 VTABLE_set_pointer_keyed_str(interp, method, signature, func);
764
765 /* insert it into namespace */
766 VTABLE_set_pmc_keyed_str(interp, interp->vtables[type]->_namespace,
767 name, method);
768 }
769
770 /*
771
772 =item C<void Parrot_interp_mark_method_writes(PARROT_INTERP, int type, const
773 char *name)>
774
775 Mark the method C<name> on PMC type C<type> as one that modifies the PMC.
776
777 =cut
778
779 */
780
781 PARROT_EXPORT
782 void
Parrot_interp_mark_method_writes(PARROT_INTERP,int type,ARGIN (const char * name))783 Parrot_interp_mark_method_writes(PARROT_INTERP, int type, ARGIN(const char *name))
784 {
785 ASSERT_ARGS(Parrot_interp_mark_method_writes)
786 STRING * const str_name = Parrot_str_new_constant(interp, name);
787 PMC * const pmc_true = Parrot_pmc_new_init_int(interp, enum_class_Integer, 1);
788 PMC * const method = VTABLE_get_pmc_keyed_str(interp,
789 interp->vtables[type]->_namespace, str_name);
790 Parrot_pmc_setprop(interp, method, CONST_STRING(interp, "write"), pmc_true);
791 }
792
793 /*
794
795 =item C<PMC * Parrot_interp_get_compiler(PARROT_INTERP, STRING *type)>
796
797 Get a compiler PMC.
798
799 =cut
800
801 */
802
803 PARROT_EXPORT
804 PARROT_WARN_UNUSED_RESULT
805 PARROT_CANNOT_RETURN_NULL
806 PMC *
Parrot_interp_get_compiler(PARROT_INTERP,ARGIN (STRING * type))807 Parrot_interp_get_compiler(PARROT_INTERP, ARGIN(STRING *type))
808 {
809 ASSERT_ARGS(Parrot_interp_get_compiler)
810 PMC * const hash = VTABLE_get_pmc_keyed_int(interp, interp->iglobals, IGLOBALS_COMPREG_HASH);
811
812 /* No compiler has been registered yet */
813 if (PMC_IS_NULL(hash))
814 return PMCNULL;
815
816 /* Fetch the compiler */
817 return VTABLE_get_pmc_keyed_str(interp, hash, type);
818 }
819
820 /*
821
822 =item C<void Parrot_interp_set_compiler(PARROT_INTERP, STRING *type, PMC
823 *compiler)>
824
825 Register a parser/compiler PMC.
826
827 =cut
828
829 */
830
831 PARROT_EXPORT
832 void
Parrot_interp_set_compiler(PARROT_INTERP,ARGIN (STRING * type),ARGIN (PMC * compiler))833 Parrot_interp_set_compiler(PARROT_INTERP, ARGIN(STRING *type), ARGIN(PMC *compiler))
834 {
835 ASSERT_ARGS(Parrot_interp_set_compiler)
836 PMC * const iglobals = interp->iglobals;
837 PMC * hash = VTABLE_get_pmc_keyed_int(interp, interp->iglobals, IGLOBALS_COMPREG_HASH);
838
839 if (PMC_IS_NULL(hash)) {
840 hash = Parrot_pmc_new_noinit(interp, enum_class_Hash);
841 VTABLE_init(interp, hash);
842 VTABLE_set_pmc_keyed_int(interp, iglobals,
843 (INTVAL)IGLOBALS_COMPREG_HASH, hash);
844 }
845
846 VTABLE_set_pmc_keyed_str(interp, hash, type, compiler);
847 }
848
849 /*
850
851 =item C<PMC * Parrot_interp_compile_file(PARROT_INTERP, PMC *compiler, STRING
852 *fullname)>
853
854 Compile code file. Take a reference to a compiler PMC. Currently only PIR and
855 PASM compilers (IMCC-based) are supported
856
857 TODO: This should probably be deleted entirely, and higher-level compilation
858 abstractions used instead.
859
860 =cut
861
862 */
863
864 PARROT_EXPORT
865 PARROT_CANNOT_RETURN_NULL
866 PMC *
Parrot_interp_compile_file(PARROT_INTERP,ARGIN (PMC * compiler),ARGIN (STRING * fullname))867 Parrot_interp_compile_file(PARROT_INTERP, ARGIN(PMC *compiler), ARGIN(STRING *fullname))
868 {
869 ASSERT_ARGS(Parrot_interp_compile_file)
870 PMC * result = NULL;
871 UINTVAL regs_used[4] = {3, 3, 3, 3};
872 PMC * const newcontext = Parrot_push_context(interp, regs_used);
873 imc_info_t * const imcc = (imc_info_t *) VTABLE_get_pointer(interp, compiler);
874 const INTVAL is_pasm = VTABLE_get_integer(interp, compiler);
875
876 Parrot_block_GC_mark(interp);
877 Parrot_pcc_set_HLL(interp, newcontext, 0);
878 Parrot_pcc_set_sub(interp, newcontext, 0);
879
880 imcc_reset(imcc);
881 result = imcc_compile_file(imcc, fullname, is_pasm);
882 if (PMC_IS_NULL(result)) {
883 STRING * const msg = imcc_last_error_message(imcc);
884 INTVAL code = imcc_last_error_code(imcc);
885 Parrot_ex_throw_from_c_args(interp, NULL, code, "%Ss", msg);
886 }
887
888 Parrot_pop_context(interp);
889 Parrot_unblock_GC_mark(interp);
890
891 return result;
892 }
893
894 /*
895
896 =item C<Parrot_PMC Parrot_interp_compile_string(PARROT_INTERP, PMC *compiler,
897 STRING *code)>
898
899 Compiles a code string.
900
901 =cut
902
903 */
904
905 PARROT_EXPORT
906 PARROT_CAN_RETURN_NULL
907 PARROT_WARN_UNUSED_RESULT
908 Parrot_PMC
Parrot_interp_compile_string(PARROT_INTERP,ARGIN (PMC * compiler),ARGIN (STRING * code))909 Parrot_interp_compile_string(PARROT_INTERP, ARGIN(PMC *compiler), ARGIN(STRING *code))
910 {
911 ASSERT_ARGS(Parrot_interp_compile_string)
912
913 PMC *result;
914 imc_info_t * const imcc = (imc_info_t*) VTABLE_get_pointer(interp, compiler);
915 const INTVAL is_pasm = VTABLE_get_integer(interp, compiler);
916
917 Parrot_block_GC_mark(interp);
918 result = imcc_compile_string(imcc, code, is_pasm);
919 if (PMC_IS_NULL(result)) {
920 STRING * const msg = imcc_last_error_message(imcc);
921 const INTVAL error_code = imcc_last_error_code(imcc);
922
923 Parrot_unblock_GC_mark(interp);
924 Parrot_ex_throw_from_c_args(interp, NULL, error_code, "%Ss", msg);
925 }
926 Parrot_unblock_GC_mark(interp);
927 return result;
928 }
929
930 /*
931
932 =item C<INTVAL Parrot_interp_info(PARROT_INTERP, INTVAL what)>
933
934 C<what> specifies the type of information you want about the interpreter.
935
936 =cut
937
938 */
939
940 PARROT_EXPORT
941 PARROT_WARN_UNUSED_RESULT
942 INTVAL
Parrot_interp_info(PARROT_INTERP,INTVAL what)943 Parrot_interp_info(PARROT_INTERP, INTVAL what)
944 {
945 ASSERT_ARGS(Parrot_interp_info)
946 INTVAL ret;
947
948 switch (what) {
949 case MAX_GENERATIONS:
950 Parrot_warn_experimental(interp, "MAX_GENERATIONS option is experimental");
951 if (interp->gc_sys->sys_type == GMS)
952 ret = Parrot_gc_max_generations(interp);
953 else
954 ret = 0;
955 break;
956 case TOTAL_MEM_ALLOC:
957 ret = Parrot_gc_total_memory_allocated(interp);
958 break;
959 case TOTAL_MEM_USED:
960 ret = Parrot_gc_total_memory_used(interp);
961 break;
962 case GC_MARK_RUNS:
963 ret = Parrot_gc_count_mark_runs(interp);
964 break;
965 case GC_LAZY_MARK_RUNS:
966 ret = Parrot_gc_count_lazy_mark_runs(interp);
967 break;
968 case GC_COLLECT_RUNS:
969 ret = Parrot_gc_count_collect_runs(interp);
970 break;
971 case ACTIVE_PMCS:
972 ret = Parrot_gc_active_pmcs(interp);
973 break;
974 case ACTIVE_BUFFERS:
975 ret = Parrot_gc_active_sized_buffers(interp);
976 break;
977 case TOTAL_PMCS:
978 ret = Parrot_gc_total_pmcs(interp);
979 break;
980 case TOTAL_BUFFERS:
981 ret = Parrot_gc_total_sized_buffers(interp);
982 break;
983 case HEADER_ALLOCS_SINCE_COLLECT:
984 ret = Parrot_gc_headers_alloc_since_last_collect(interp);
985 break;
986 case MEM_ALLOCS_SINCE_COLLECT:
987 ret = Parrot_gc_mem_alloc_since_last_collect(interp);
988 break;
989 case TOTAL_COPIED:
990 ret = Parrot_gc_total_copied(interp);
991 break;
992 case IMPATIENT_PMCS:
993 ret = Parrot_gc_impatient_pmcs(interp);
994 break;
995 case CURRENT_RUNCORE:
996 ret = interp->run_core->id;
997 break;
998 /*
999 * sysinfo attributes go here.
1000 * We may deprecate sysinfo dynop in favour of interpinfo in future,
1001 * or retain both.
1002 */
1003 case PARROT_INTSIZE:
1004 ret = sizeof (INTVAL);
1005 break;
1006 case PARROT_FLOATSIZE:
1007 ret = sizeof (FLOATVAL);
1008 break;
1009 case PARROT_POINTERSIZE:
1010 ret = sizeof (void *);
1011 break;
1012 case PARROT_INTMIN:
1013 ret = PARROT_INTVAL_MIN;
1014 break;
1015 case PARROT_INTMAX:
1016 ret = PARROT_INTVAL_MAX;
1017 break;
1018 default: /* or a warning only? */
1019 ret = -1;
1020 Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_UNIMPLEMENTED,
1021 "illegal argument in Parrot_interp_info");
1022 }
1023 return ret;
1024 }
1025
1026 /*
1027
1028 =item C<PMC* Parrot_interp_info_p(PARROT_INTERP, INTVAL what)>
1029
1030 C<what> specifies the type of information you want about the
1031 interpreter.
1032
1033 =cut
1034
1035 */
1036
1037 PARROT_EXPORT
1038 PARROT_WARN_UNUSED_RESULT
1039 PARROT_CANNOT_RETURN_NULL
1040 PMC*
Parrot_interp_info_p(PARROT_INTERP,INTVAL what)1041 Parrot_interp_info_p(PARROT_INTERP, INTVAL what)
1042 {
1043 ASSERT_ARGS(Parrot_interp_info_p)
1044
1045 PMC *result;
1046 switch (what) {
1047 case CURRENT_CTX:
1048 result = CURRENT_CONTEXT(interp);
1049 break;
1050 case CURRENT_SUB:
1051 result = Parrot_pcc_get_sub(interp, CURRENT_CONTEXT(interp));
1052 break;
1053 case CURRENT_CONT:
1054 result = Parrot_pcc_get_continuation(interp, CURRENT_CONTEXT(interp));
1055 break;
1056 case CURRENT_LEXPAD:
1057 result = Parrot_pcc_get_lex_pad(interp, CURRENT_CONTEXT(interp));
1058 break;
1059 case CURRENT_TASK:
1060 result = Parrot_cx_current_task(interp);
1061 break;
1062 default: /* or a warning only? */
1063 Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_UNIMPLEMENTED,
1064 "illegal argument in Parrot_interp_info_p");
1065 }
1066
1067 /* Don't send NULL values to P registers */
1068 return result ? result : PMCNULL;
1069 }
1070
1071 /*
1072
1073 =item C<STRING* Parrot_interp_info_s(PARROT_INTERP, INTVAL what)>
1074
1075 Takes an interpreter name and an information type as arguments.
1076 Returns corresponding information strings about the interpreter:
1077 the full pathname, executable name, or the file stem,
1078 (or throws an error exception, if the type is not recognized).
1079 Valid types are EXECUTABLE_FULLNAME, EXECUTABLE_BASENAME,
1080 and RUNTIME_PREFIX.
1081
1082 =cut
1083
1084 */
1085
1086 PARROT_EXPORT
1087 PARROT_WARN_UNUSED_RESULT
1088 PARROT_CANNOT_RETURN_NULL
1089 STRING*
Parrot_interp_info_s(PARROT_INTERP,INTVAL what)1090 Parrot_interp_info_s(PARROT_INTERP, INTVAL what)
1091 {
1092 ASSERT_ARGS(Parrot_interp_info_s)
1093 switch (what) {
1094 case EXECUTABLE_FULLNAME: {
1095 PMC * const exe_name = VTABLE_get_pmc_keyed_int(interp, interp->iglobals,
1096 IGLOBALS_EXECUTABLE);
1097 if (PMC_IS_NULL(exe_name))
1098 return CONST_STRING(interp, "");
1099 return VTABLE_get_string(interp, exe_name);
1100 }
1101 case EXECUTABLE_BASENAME: {
1102 PMC * const exe_name = VTABLE_get_pmc_keyed_int(interp,
1103 interp->iglobals, IGLOBALS_EXECUTABLE);
1104
1105 if (PMC_IS_NULL(exe_name))
1106 return CONST_STRING(interp, "");
1107
1108 else {
1109 /* Need to strip back to what follows the final / or \. */
1110 STRING * const fullname = VTABLE_get_string(interp, exe_name);
1111 const int len = STRING_length(fullname);
1112 int pos;
1113
1114 for (pos = len - 1; pos > 0; --pos) {
1115 const INTVAL c = STRING_ord(interp, fullname, pos);
1116
1117 if (c == '/' || c == '\\') {
1118 ++pos;
1119 break;
1120 }
1121 }
1122
1123 return Parrot_str_substr(interp, fullname, pos, len - pos);
1124 }
1125 }
1126 case RUNTIME_PREFIX:
1127 return Parrot_get_runtime_path(interp);
1128 case GC_SYS_NAME: {
1129 STRING * const name = Parrot_gc_sys_name(interp);
1130 Parrot_warn_experimental(interp, "GC_SYS_NAME option is experimental");
1131 return name;
1132 }
1133 case CURRENT_RUNCORE:
1134 return interp->run_core->name;
1135 /*
1136 * sysinfo attributes go here. we may deprecate these in favour of interpinfo ops
1137 * in future.
1138 */
1139 case PARROT_OS:
1140 return Parrot_str_new_constant(interp, BUILD_OS_NAME);
1141 case CPU_ARCH:
1142 return Parrot_str_new_init(interp, PARROT_CPU_ARCH,
1143 sizeof (PARROT_CPU_ARCH) - 1, Parrot_ascii_encoding_ptr, 0);
1144 case CPU_TYPE:
1145 return Parrot_get_cpu_type(interp);
1146
1147 #ifdef PARROT_HAS_HEADER_SYSUTSNAME
1148 case PARROT_OS_VERSION:
1149 {
1150 struct utsname info;
1151 if (uname(&info) == 0) {
1152 return Parrot_str_new_init(interp, info.version,
1153 strlen(info.version), Parrot_ascii_encoding_ptr, 0);
1154 }
1155 }
1156 break;
1157 case PARROT_OS_VERSION_NUMBER:
1158 {
1159 struct utsname info;
1160 if (uname(&info) == 0) {
1161 return Parrot_str_new_init(interp, info.release,
1162 strlen(info.release), Parrot_ascii_encoding_ptr, 0);
1163 }
1164 }
1165 break;
1166 #endif
1167 default:
1168 Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_UNIMPLEMENTED,
1169 "illegal argument in Parrot_interp_info_s");
1170 }
1171 return CONST_STRING(interp, ""); /* in case of errors */
1172 }
1173
1174 /*
1175
1176 =item C<Interp * Parrot_interp_get_from_pmc(PMC * interp_pmc)>
1177
1178 C<interp_pmc> is a ParrotInterpreter PMC. Extract the raw C<Interp*> from it
1179 without needing an existing C<Interp *> reference.
1180
1181 Do not use with any other type of PMC.
1182
1183 =cut
1184
1185 */
1186
1187 PARROT_EXPORT
1188 PARROT_CANNOT_RETURN_NULL
1189 Interp *
Parrot_interp_get_from_pmc(ARGIN (PMC * interp_pmc))1190 Parrot_interp_get_from_pmc(ARGIN(PMC * interp_pmc))
1191 {
1192 ASSERT_ARGS(Parrot_interp_get_from_pmc)
1193 PARROT_ASSERT(interp_pmc->vtable->base_type == enum_class_ParrotInterpreter);
1194 return ((Parrot_ParrotInterpreter_attributes*)interp_pmc->data)->interp;
1195 }
1196
1197 /*
1198
1199 =item C<void Parrot_interp_set_flag(PARROT_INTERP, INTVAL flag)>
1200
1201 Sets on any of the following flags, specified by C<flag>, in the interpreter:
1202
1203 Flag Effect
1204 C<PARROT_BOUNDS_FLAG> enable bounds checking
1205 C<PARROT_PROFILE_FLAG> enable profiling,
1206
1207 =cut
1208
1209 */
1210
1211 PARROT_EXPORT
1212 void
Parrot_interp_set_flag(PARROT_INTERP,INTVAL flag)1213 Parrot_interp_set_flag(PARROT_INTERP, INTVAL flag)
1214 {
1215 ASSERT_ARGS(Parrot_interp_set_flag)
1216 /* These two macros (from interpreter.h) do exactly what they look like. */
1217
1218 Interp_flags_SET(interp, flag);
1219 switch (flag) {
1220 case PARROT_BOUNDS_FLAG:
1221 case PARROT_PROFILE_FLAG:
1222 Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "slow"));
1223 break;
1224 default:
1225 break;
1226 }
1227 }
1228
1229
1230 /*
1231
1232 =item C<void Parrot_interp_set_debug(PARROT_INTERP, UINTVAL flag)>
1233
1234 Set a debug flag: C<PARROT_DEBUG_FLAG>.
1235
1236 =cut
1237
1238 */
1239
1240 PARROT_EXPORT
1241 void
Parrot_interp_set_debug(PARROT_INTERP,UINTVAL flag)1242 Parrot_interp_set_debug(PARROT_INTERP, UINTVAL flag)
1243 {
1244 ASSERT_ARGS(Parrot_interp_set_debug)
1245 interp->debug_flags |= flag;
1246 }
1247
1248
1249 /*
1250
1251 =item C<void Parrot_interp_set_executable_name(PARROT_INTERP, STRING * const
1252 name)>
1253
1254 Sets the name of the executable launching Parrot (see C<pbc_to_exe> and the
1255 C<parrot> binary).
1256
1257 =cut
1258
1259 */
1260
1261 PARROT_EXPORT
1262 void
Parrot_interp_set_executable_name(PARROT_INTERP,ARGIN (STRING * const name))1263 Parrot_interp_set_executable_name(PARROT_INTERP, ARGIN(STRING * const name))
1264 {
1265 ASSERT_ARGS(Parrot_interp_set_executable_name)
1266 PMC * const name_pmc = Parrot_pmc_new(interp, enum_class_String);
1267 VTABLE_set_string_native(interp, name_pmc, name);
1268 VTABLE_set_pmc_keyed_int(interp, interp->iglobals, IGLOBALS_EXECUTABLE,
1269 name_pmc);
1270 }
1271
1272
1273 /*
1274
1275 =item C<void Parrot_interp_set_trace(PARROT_INTERP, UINTVAL flag)>
1276
1277 Set a trace flag: C<PARROT_TRACE_FLAG>
1278
1279 =cut
1280
1281 */
1282
1283 PARROT_EXPORT
1284 void
Parrot_interp_set_trace(PARROT_INTERP,UINTVAL flag)1285 Parrot_interp_set_trace(PARROT_INTERP, UINTVAL flag)
1286 {
1287 ASSERT_ARGS(Parrot_interp_set_trace)
1288 Parrot_pcc_trace_flags_on(interp, interp->ctx, flag);
1289 Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "slow"));
1290 }
1291
1292
1293 /*
1294
1295 =item C<void Parrot_interp_clear_flag(PARROT_INTERP, INTVAL flag)>
1296
1297 Clears a flag in the interpreter.
1298
1299 =cut
1300
1301 */
1302
1303 PARROT_EXPORT
1304 void
Parrot_interp_clear_flag(PARROT_INTERP,INTVAL flag)1305 Parrot_interp_clear_flag(PARROT_INTERP, INTVAL flag)
1306 {
1307 ASSERT_ARGS(Parrot_interp_clear_flag)
1308 Interp_flags_CLEAR(interp, flag);
1309 }
1310
1311
1312 /*
1313
1314 =item C<void Parrot_interp_clear_debug(PARROT_INTERP, UINTVAL flag)>
1315
1316 Clears a flag in the interpreter.
1317
1318 =cut
1319
1320 */
1321
1322 PARROT_EXPORT
1323 void
Parrot_interp_clear_debug(PARROT_INTERP,UINTVAL flag)1324 Parrot_interp_clear_debug(PARROT_INTERP, UINTVAL flag)
1325 {
1326 ASSERT_ARGS(Parrot_interp_clear_debug)
1327 interp->debug_flags &= ~flag;
1328 }
1329
1330
1331 /*
1332
1333 =item C<void Parrot_interp_clear_trace(PARROT_INTERP, UINTVAL flag)>
1334
1335 Clears a flag in the interpreter.
1336
1337 =cut
1338
1339 */
1340
1341 PARROT_EXPORT
1342 void
Parrot_interp_clear_trace(PARROT_INTERP,UINTVAL flag)1343 Parrot_interp_clear_trace(PARROT_INTERP, UINTVAL flag)
1344 {
1345 ASSERT_ARGS(Parrot_interp_clear_trace)
1346 Parrot_pcc_trace_flags_off(interp, interp->ctx, flag);
1347 }
1348
1349
1350 /*
1351
1352 =item C<Parrot_Int Parrot_interp_test_flag(PARROT_INTERP, INTVAL flag)>
1353
1354 Test the interpreter flags specified in C<flag>.
1355
1356 =cut
1357
1358 */
1359
1360 PARROT_EXPORT
1361 PARROT_PURE_FUNCTION
1362 Parrot_Int
Parrot_interp_test_flag(PARROT_INTERP,INTVAL flag)1363 Parrot_interp_test_flag(PARROT_INTERP, INTVAL flag)
1364 {
1365 ASSERT_ARGS(Parrot_interp_test_flag)
1366 return Interp_flags_TEST(interp, flag);
1367 }
1368
1369
1370 /*
1371
1372 =item C<Parrot_UInt Parrot_interp_test_debug(PARROT_INTERP, UINTVAL flag)>
1373
1374 Test the interpreter flags specified in C<flag>.
1375
1376 =cut
1377
1378 */
1379
1380 PARROT_EXPORT
1381 PARROT_PURE_FUNCTION
1382 Parrot_UInt
Parrot_interp_test_debug(PARROT_INTERP,UINTVAL flag)1383 Parrot_interp_test_debug(PARROT_INTERP, UINTVAL flag)
1384 {
1385 ASSERT_ARGS(Parrot_interp_test_debug)
1386 return interp->debug_flags & flag;
1387 }
1388
1389
1390 /*
1391
1392 =item C<Parrot_UInt Parrot_interp_test_trace(PARROT_INTERP, UINTVAL flag)>
1393
1394 Test the interpreter flags specified in C<flag>.
1395
1396 =cut
1397
1398 */
1399
1400 PARROT_EXPORT
1401 PARROT_PURE_FUNCTION
1402 Parrot_UInt
Parrot_interp_test_trace(PARROT_INTERP,UINTVAL flag)1403 Parrot_interp_test_trace(PARROT_INTERP, UINTVAL flag)
1404 {
1405 ASSERT_ARGS(Parrot_interp_test_trace)
1406 return Parrot_pcc_trace_flags_test(interp, interp->ctx, flag);
1407 }
1408
1409
1410 /*
1411
1412 =item C<void Parrot_interp_set_run_core(PARROT_INTERP, Parrot_Run_core_t core)>
1413
1414 Sets the specified run core.
1415
1416 =cut
1417
1418 */
1419
1420 PARROT_EXPORT
1421 void
Parrot_interp_set_run_core(PARROT_INTERP,Parrot_Run_core_t core)1422 Parrot_interp_set_run_core(PARROT_INTERP, Parrot_Run_core_t core)
1423 {
1424 ASSERT_ARGS(Parrot_interp_set_run_core)
1425 switch (core) {
1426 case PARROT_SLOW_CORE:
1427 Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "slow"));
1428 break;
1429 case PARROT_FAST_CORE:
1430 Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "fast"));
1431 break;
1432 case PARROT_EXEC_CORE:
1433 Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "exec"));
1434 break;
1435 case PARROT_GC_DEBUG_CORE:
1436 Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "gc_debug"));
1437 break;
1438 case PARROT_DEBUGGER_CORE:
1439 Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "debugger"));
1440 break;
1441 case PARROT_PROFILING_CORE:
1442 Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "profiling"));
1443 break;
1444 case PARROT_SUBPROF_SUB_CORE:
1445 Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "subprof_sub"));
1446 break;
1447 case PARROT_SUBPROF_HLL_CORE:
1448 Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "subprof_hll"));
1449 break;
1450 case PARROT_SUBPROF_OPS_CORE:
1451 Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "subprof_ops"));
1452 break;
1453 default:
1454 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
1455 "Invalid runcore %d requested", (int)core);
1456 }
1457 }
1458
1459
1460 /*
1461
1462 =item C<void Parrot_interp_set_warnings(PARROT_INTERP, Parrot_warnclass wc)>
1463
1464 Activates the given warnings.
1465
1466 =cut
1467
1468 */
1469
1470 PARROT_EXPORT
1471 void
Parrot_interp_set_warnings(PARROT_INTERP,Parrot_warnclass wc)1472 Parrot_interp_set_warnings(PARROT_INTERP, Parrot_warnclass wc)
1473 {
1474 ASSERT_ARGS(Parrot_interp_set_warnings)
1475 /* Activates the given warnings. (Macro from warnings.h.) */
1476 PARROT_WARNINGS_on(interp, wc);
1477 }
1478
1479 /*
1480
1481 =back
1482
1483 =head1 SEE ALSO
1484
1485 L<include/parrot/interpreter.h>
1486
1487 =cut
1488
1489 */
1490
1491 /*
1492 * Local variables:
1493 * c-file-style: "parrot"
1494 * End:
1495 * vim: expandtab shiftwidth=4 cinoptions='\:2=2' :
1496 */
1497