2 Copyright (C) 2001-2009, Parrot Foundation.
7 src/thread.c - Thread handling stuff
11 Threads are created by creating new C<ParrotInterpreter> objects.
21 #include "parrot/parrot.h"
22 #include "parrot/atomic.h"
23 #include "pmc/pmc_sub.h"
24 #include "pmc/pmc_parrotinterpreter.h"
26 /* HEADERIZER HFILE: include/parrot/thread.h */
28 /* HEADERIZER BEGIN: static */
29 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
31 static Parrot_Interp
detach(UINTVAL tid
);
32 PARROT_CAN_RETURN_NULL
33 static Shared_gc_info
* get_pool(PARROT_INTERP
)
34 __attribute__nonnull__(1);
36 PARROT_WARN_UNUSED_RESULT
37 static int is_suspended_for_gc(PARROT_INTERP
)
38 __attribute__nonnull__(1);
40 PARROT_CAN_RETURN_NULL
41 static PMC
* make_local_args_copy(PARROT_INTERP
,
42 ARGIN(Parrot_Interp old_interp
),
43 ARGIN_NULLOK(PMC
*args
))
44 __attribute__nonnull__(1)
45 __attribute__nonnull__(2);
47 PARROT_CAN_RETURN_NULL
48 static PMC
* make_local_copy(PARROT_INTERP
,
49 ARGIN(Parrot_Interp from
),
51 __attribute__nonnull__(1)
52 __attribute__nonnull__(2)
53 __attribute__nonnull__(3);
55 static void mutex_unlock(ARGMOD(void *arg
))
56 __attribute__nonnull__(1)
59 static Parrot_Interp
pt_check_tid(UINTVAL tid
, ARGIN(const char *from
))
60 __attribute__nonnull__(2);
62 static int pt_gc_count_threads(PARROT_INTERP
)
63 __attribute__nonnull__(1);
65 static void pt_gc_wait_for_stage(PARROT_INTERP
,
66 thread_gc_stage_enum from_stage
,
67 thread_gc_stage_enum to_stage
)
68 __attribute__nonnull__(1);
70 static void pt_gc_wakeup_check(PARROT_INTERP
)
71 __attribute__nonnull__(1);
73 static void pt_ns_clone(PARROT_INTERP
,
74 ARGOUT(Parrot_Interp d
),
76 ARGIN(Parrot_Interp s
),
77 ARGIN(PMC
*source_ns
))
78 __attribute__nonnull__(1)
79 __attribute__nonnull__(2)
80 __attribute__nonnull__(3)
81 __attribute__nonnull__(4)
82 __attribute__nonnull__(5)
84 FUNC_MODIFIES(*dest_ns
);
86 static void pt_suspend_all_for_gc(PARROT_INTERP
)
87 __attribute__nonnull__(1);
89 static void pt_suspend_one_for_gc(PARROT_INTERP
)
90 __attribute__nonnull__(1);
92 static void pt_thread_signal(NOTNULL(Parrot_Interp self
), PARROT_INTERP
)
93 __attribute__nonnull__(1)
94 __attribute__nonnull__(2);
96 static void pt_thread_wait(PARROT_INTERP
)
97 __attribute__nonnull__(1);
99 PARROT_CAN_RETURN_NULL
100 static QUEUE_ENTRY
* remove_queued_suspend_gc(PARROT_INTERP
)
101 __attribute__nonnull__(1);
103 PARROT_CAN_RETURN_NULL
104 static void* thread_func(ARGIN_NULLOK(void *arg
));
106 #define ASSERT_ARGS_detach __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
107 #define ASSERT_ARGS_get_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
108 PARROT_ASSERT_ARG(interp))
109 #define ASSERT_ARGS_is_suspended_for_gc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
110 PARROT_ASSERT_ARG(interp))
111 #define ASSERT_ARGS_make_local_args_copy __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
112 PARROT_ASSERT_ARG(interp) \
113 , PARROT_ASSERT_ARG(old_interp))
114 #define ASSERT_ARGS_make_local_copy __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
115 PARROT_ASSERT_ARG(interp) \
116 , PARROT_ASSERT_ARG(from) \
117 , PARROT_ASSERT_ARG(arg))
118 #define ASSERT_ARGS_mutex_unlock __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
119 PARROT_ASSERT_ARG(arg))
120 #define ASSERT_ARGS_pt_check_tid __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
121 PARROT_ASSERT_ARG(from))
122 #define ASSERT_ARGS_pt_gc_count_threads __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
123 PARROT_ASSERT_ARG(interp))
124 #define ASSERT_ARGS_pt_gc_wait_for_stage __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
125 PARROT_ASSERT_ARG(interp))
126 #define ASSERT_ARGS_pt_gc_wakeup_check __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
127 PARROT_ASSERT_ARG(interp))
128 #define ASSERT_ARGS_pt_ns_clone __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
129 PARROT_ASSERT_ARG(interp) \
130 , PARROT_ASSERT_ARG(d) \
131 , PARROT_ASSERT_ARG(dest_ns) \
132 , PARROT_ASSERT_ARG(s) \
133 , PARROT_ASSERT_ARG(source_ns))
134 #define ASSERT_ARGS_pt_suspend_all_for_gc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
135 PARROT_ASSERT_ARG(interp))
136 #define ASSERT_ARGS_pt_suspend_one_for_gc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
137 PARROT_ASSERT_ARG(interp))
138 #define ASSERT_ARGS_pt_thread_signal __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
139 PARROT_ASSERT_ARG(self) \
140 , PARROT_ASSERT_ARG(interp))
141 #define ASSERT_ARGS_pt_thread_wait __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
142 PARROT_ASSERT_ARG(interp))
143 #define ASSERT_ARGS_remove_queued_suspend_gc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
144 PARROT_ASSERT_ARG(interp))
145 #define ASSERT_ARGS_thread_func __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
146 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
147 /* HEADERIZER END: static */
149 #if defined THREAD_DEBUG && THREAD_DEBUG
150 # define DEBUG_ONLY(x) (x)
152 # define DEBUG_ONLY(x)
155 static int running_threads
;
157 void Parrot_really_destroy(PARROT_INTERP
, int exit_code
, void *arg
);
161 =item C<static PMC * make_local_copy(PARROT_INTERP, Parrot_Interp from, PMC
164 Creates a local copy of the PMC if necessary. (No copy is made if it is marked
165 shared.) This includes workarounds for Parrot_clone() not doing the Right Thing
166 with subroutines (specifically, code segments aren't preserved and it is
167 difficult to do so as long as Parrot_clone() depends on freezing).
173 PARROT_CAN_RETURN_NULL
175 make_local_copy(PARROT_INTERP
, ARGIN(Parrot_Interp from
), ARGIN(PMC
*arg
))
177 ASSERT_ARGS(make_local_copy
)
179 STRING
* const _sub
= interp
->vtables
[enum_class_Sub
]->whoami
;
180 STRING
* const _multi_sub
= interp
->vtables
[enum_class_MultiSub
]->whoami
;
182 if (PMC_IS_NULL(arg
)) {
185 else if (PObj_is_PMC_shared_TEST(arg
)) {
188 else if (VTABLE_isa(from
, arg
, _multi_sub
)) {
190 const INTVAL n
= VTABLE_elements(from
, arg
);
191 ret_val
= pmc_new(interp
, enum_class_MultiSub
);
193 for (i
= 0; i
< n
; ++i
) {
194 PMC
*const orig
= VTABLE_get_pmc_keyed_int(from
, arg
, i
);
195 PMC
*const copy
= make_local_copy(interp
, from
, orig
);
196 VTABLE_push_pmc(interp
, ret_val
, copy
);
199 else if (VTABLE_isa(from
, arg
, _sub
)) {
200 /* this is a workaround for cloning subroutines not actually
201 * working as one might expect mainly because the segment is
202 * not correctly copied
204 Parrot_Sub_attributes
*ret_val_sub
, *arg_sub
;
206 ret_val
= Parrot_clone(interp
, arg
);
207 PMC_get_sub(interp
, ret_val
, ret_val_sub
);
208 PMC_get_sub(interp
, arg
, arg_sub
);
209 ret_val_sub
->seg
= arg_sub
->seg
;
210 /* Skip vtable overrides and methods. */
211 if (ret_val_sub
->vtable_index
== -1
212 && !(ret_val_sub
->comp_flags
& SUB_COMP_FLAG_METHOD
)) {
213 Parrot_store_sub_in_namespace(interp
, ret_val
);
217 ret_val
= Parrot_clone(interp
, arg
);
224 =item C<static Shared_gc_info * get_pool(PARROT_INTERP)>
226 Gets the shared gc information. For now this is global data; ideally it will
227 become something other than a static variable. If everything uses this
228 function, it will be easier to change.
234 PARROT_CAN_RETURN_NULL
235 static Shared_gc_info
*
236 get_pool(PARROT_INTERP
)
238 ASSERT_ARGS(get_pool
)
239 return shared_gc_info
;
244 =item C<void pt_free_pool(PARROT_INTERP)>
246 Frees the shared GC information. This clears any global data when joining all
247 threads at parent interpreter destruction.
254 pt_free_pool(PARROT_INTERP
)
256 ASSERT_ARGS(pt_free_pool
)
257 if (shared_gc_info
) {
258 COND_DESTROY(shared_gc_info
->gc_cond
);
259 PARROT_ATOMIC_INT_DESTROY(shared_gc_info
->gc_block_level
);
260 mem_sys_free(shared_gc_info
);
261 shared_gc_info
= NULL
;
267 =item C<static PMC * make_local_args_copy(PARROT_INTERP, Parrot_Interp
268 old_interp, PMC *args)>
270 Make a local copy of the corresponding array of arguments.
276 PARROT_CAN_RETURN_NULL
278 make_local_args_copy(PARROT_INTERP
, ARGIN(Parrot_Interp old_interp
), ARGIN_NULLOK(PMC
*args
))
280 ASSERT_ARGS(make_local_args_copy
)
285 if (PMC_IS_NULL(args
))
288 old_size
= VTABLE_get_integer(old_interp
, args
);
290 /* XXX should this be a different type? */
291 ret_val
= pmc_new(interp
, enum_class_FixedPMCArray
);
292 VTABLE_set_integer_native(interp
, ret_val
, old_size
);
294 for (i
= 0; i
< old_size
; ++i
) {
295 PMC
* const copy
= make_local_copy(interp
, old_interp
,
296 VTABLE_get_pmc_keyed_int(old_interp
, args
, i
));
298 VTABLE_set_pmc_keyed_int(interp
, ret_val
, i
, copy
);
306 =item C<PMC * pt_shared_fixup(PARROT_INTERP, PMC *pmc)>
308 Modifies a PMC to be sharable. Right now, reassigns the vtable to one
309 owned by some master interpreter, so the PMC can be safely reused
312 In the future the PMC returned might be different than the one
313 passed, e.g., if we need to reallocate the PMC in a different
320 PARROT_CAN_RETURN_NULL
322 pt_shared_fixup(PARROT_INTERP
, ARGMOD(PMC
*pmc
))
324 ASSERT_ARGS(pt_shared_fixup
)
325 /* TODO this will need to change for thread pools
326 * XXX should we have a separate interpreter for this?
329 Parrot_Interp master
= interpreter_array
[0];
330 const int is_ro
= pmc
->vtable
->flags
& VTABLE_IS_READONLY_FLAG
;
332 /* This lock is paired with one in objects.c. It is necessary to protect
333 * against the master interpreter adding classes and consequently
334 * resizing its classname->type_id hashtable and/or expanding its vtable
336 * TODO investigate if a read-write lock results in substantially
337 * better performance.
339 LOCK_INTERPRETER(master
);
340 type_num
= pmc
->vtable
->base_type
;
342 if (type_num
== enum_type_undef
) {
343 UNLOCK_INTERPRETER(master
);
344 Parrot_ex_throw_from_c_args(interp
, NULL
, 1,
345 "pt_shared_fixup: unsharable type");
348 pmc
->vtable
= master
->vtables
[type_num
];
350 UNLOCK_INTERPRETER(master
);
353 pmc
->vtable
= pmc
->vtable
->ro_variant_vtable
;
355 Parrot_gc_add_pmc_sync(interp
, pmc
);
357 PObj_is_PMC_shared_SET(pmc
);
359 /* make sure metadata doesn't go away unexpectedly */
360 if (PMC_metadata(pmc
))
361 PMC_metadata(pmc
) = pt_shared_fixup(interp
, PMC_metadata(pmc
));
368 =item C<static void pt_thread_signal(Parrot_Interp self, PARROT_INTERP)>
370 Wakes up an C<interp> which should have called pt_thread_wait().
377 pt_thread_signal(NOTNULL(Parrot_Interp self
), PARROT_INTERP
)
379 ASSERT_ARGS(pt_thread_signal
)
380 COND_SIGNAL(interp
->thread_data
->interp_cond
);
385 =item C<void pt_thread_wait_with(PARROT_INTERP, Parrot_mutex *mutex)>
387 Waits for this interpreter to be signalled through its condition variable,
388 dealing properly with GC issues. C<*mutex> is assumed locked on entry and
389 will be locked on exit from this function. If a GC run occurs in the middle of
390 this function, then a spurious wakeup may occur.
397 pt_thread_wait_with(PARROT_INTERP
, ARGMOD(Parrot_mutex
*mutex
))
399 ASSERT_ARGS(pt_thread_wait_with
)
400 LOCK(interpreter_array_mutex
);
401 if (interp
->thread_data
->state
& THREAD_STATE_SUSPEND_GC_REQUESTED
) {
402 interp
->thread_data
->state
|= THREAD_STATE_SUSPENDED_GC
;
403 UNLOCK(interpreter_array_mutex
);
406 pt_suspend_self_for_gc(interp
);
409 /* since we unlocked the mutex something bad may have occured */
413 interp
->thread_data
->state
|= THREAD_STATE_GC_WAKEUP
;
415 UNLOCK(interpreter_array_mutex
);
416 COND_WAIT(interp
->thread_data
->interp_cond
, *mutex
);
417 LOCK(interpreter_array_mutex
);
419 interp
->thread_data
->state
&= ~THREAD_STATE_GC_WAKEUP
;
421 if (interp
->thread_data
->state
& THREAD_STATE_SUSPENDED_GC
) {
423 /* XXX loop needed? */
425 UNLOCK(interpreter_array_mutex
);
426 /* fprintf(stderr, "%p: woken up, doing GC run\n", interp); */
427 pt_suspend_self_for_gc(interp
);
428 LOCK(interpreter_array_mutex
);
429 } while (interp
->thread_data
->state
& THREAD_STATE_SUSPENDED_GC
);
431 UNLOCK(interpreter_array_mutex
);
435 UNLOCK(interpreter_array_mutex
);
441 =item C<static void pt_thread_wait(PARROT_INTERP)>
443 Waits for a signal, handling GC matters correctly. C<interpreter_array_mutex>
444 is assumed held. Spurious wakeups may occur.
451 pt_thread_wait(PARROT_INTERP
)
453 ASSERT_ARGS(pt_thread_wait
)
454 if (interp
->thread_data
->state
& THREAD_STATE_SUSPEND_GC_REQUESTED
) {
455 interp
->thread_data
->state
|= THREAD_STATE_SUSPENDED_GC
;
456 /* fprintf(stderr, "%p: pt_thread_wait, before sleep, doing GC run\n",
459 UNLOCK(interpreter_array_mutex
);
460 pt_suspend_self_for_gc(interp
);
461 LOCK(interpreter_array_mutex
);
463 /* while we were GCing, whatever we were waiting on might have
468 interp
->thread_data
->state
|= THREAD_STATE_GC_WAKEUP
;
470 COND_WAIT(interp
->thread_data
->interp_cond
, interpreter_array_mutex
);
472 interp
->thread_data
->state
&= ~THREAD_STATE_GC_WAKEUP
;
474 while (interp
->thread_data
->state
& THREAD_STATE_SUSPENDED_GC
) {
475 UNLOCK(interpreter_array_mutex
);
476 /* fprintf(stderr, "%p: woken up, doing GC run\n", interp); */
477 pt_suspend_self_for_gc(interp
);
478 LOCK(interpreter_array_mutex
);
485 =item C<static void* thread_func(void *arg)>
487 The actual thread function.
493 PARROT_CAN_RETURN_NULL
495 thread_func(ARGIN_NULLOK(void *arg
))
497 ASSERT_ARGS(thread_func
)
498 Parrot_runloop jump_point
;
501 PMC
* volatile sub_pmc
;
503 PMC
* const self
= (PMC
*) arg
;
504 PMC
*ret_val
= PMCNULL
;
505 Parrot_Interp interp
=
506 (Parrot_Interp
)((Parrot_ParrotInterpreter_attributes
*)PMC_data(self
))->interp
;
508 Parrot_block_GC_mark(interp
);
509 Parrot_block_GC_sweep(interp
);
511 /* need to set it here because argument passing can trigger GC */
512 interp
->lo_var_ptr
= &lo_var_ptr
;
513 GETATTR_ParrotInterpreter_sub(interp
, self
, sub_pmc
);
514 sub_arg
= VTABLE_get_pmc(interp
, self
);
516 if (setjmp(jump_point
.resume
)) {
517 /* caught exception */
518 /* XXX what should we really do here */
519 /* PMC *exception = Parrot_cx_peek_task(interp);
520 Parrot_io_eprintf(interp,
521 "Unhandled exception in thread with tid %d "
522 "(message=%Ss, number=%d)\n",
523 interp->thread_data->tid,
524 VTABLE_get_string(interp, exception),
525 VTABLE_get_integer_keyed_str(interp, exception,
526 Parrot_str_new_constant(interp, "type"))); */
530 Parrot_ex_add_c_handler(interp
, &jump_point
);
531 Parrot_unblock_GC_mark(interp
);
532 Parrot_unblock_GC_sweep(interp
);
533 Parrot_pcc_invoke_sub_from_c_args(interp
, sub_pmc
, "Pf->P", sub_arg
, &ret_val
);
536 /* thread is finito */
537 LOCK(interpreter_array_mutex
);
538 DEBUG_ONLY(fprintf(stderr
, "marking an thread as finished\n"));
540 interp
->thread_data
->state
|= THREAD_STATE_FINISHED
;
541 tid
= interp
->thread_data
->tid
;
543 if (interp
!= interpreter_array
[tid
]) {
544 UNLOCK(interpreter_array_mutex
);
545 PANIC(interp
, "thread finished: interpreter mismatch");
547 if (interp
->thread_data
->state
& THREAD_STATE_DETACHED
) {
548 interpreter_array
[tid
] = NULL
;
549 DEBUG_ONLY(fprintf(stderr
,
550 "really destroying an interpreter [exit while detached]\n"));
551 Parrot_really_destroy(interp
, 0, NULL
);
553 else if (interp
->thread_data
->state
& THREAD_STATE_JOINED
) {
554 pt_thread_signal(interp
, interp
->thread_data
->joiner
);
557 /* make sure we don't block a GC run */
558 pt_gc_wakeup_check(interp
);
559 PARROT_ASSERT(interp
->thread_data
->state
& THREAD_STATE_FINISHED
);
561 UNLOCK(interpreter_array_mutex
);
570 =head2 Helper functions used also for running plain interpreters
574 =item C<void pt_clone_code(Parrot_Interp d, Parrot_Interp s)>
576 Copies/clones the packfile/code from interpreter C<s> to C<d>. All
577 resources are created in C<d>.
584 pt_clone_code(Parrot_Interp d
, Parrot_Interp s
)
586 ASSERT_ARGS(pt_clone_code
)
587 Parrot_block_GC_mark(d
);
588 Interp_flags_SET(d
, PARROT_EXTERN_CODE_FLAG
);
590 Parrot_switch_to_cs(d
, s
->code
, 1);
591 Parrot_unblock_GC_mark(d
);
596 =item C<static void pt_ns_clone(PARROT_INTERP, Parrot_Interp d, PMC *dest_ns,
597 Parrot_Interp s, PMC *source_ns)>
599 Clones all globals from C<s> to C<d>.
606 pt_ns_clone(PARROT_INTERP
, ARGOUT(Parrot_Interp d
), ARGOUT(PMC
*dest_ns
),
607 ARGIN(Parrot_Interp s
), ARGIN(PMC
*source_ns
))
609 ASSERT_ARGS(pt_ns_clone
)
610 PMC
* const iter
= VTABLE_get_iter(s
, source_ns
);
611 const INTVAL n
= VTABLE_elements(s
, source_ns
);
614 for (i
= 0; i
< n
; ++i
) {
615 /* XXX what if 'key' is a non-constant-pool string? */
616 STRING
* const key
= VTABLE_shift_string(s
, iter
);
617 PMC
* const val
= VTABLE_get_pmc_keyed_str(s
, source_ns
, key
);
619 if (val
->vtable
->base_type
== enum_class_NameSpace
) {
620 PMC
*sub_ns
= VTABLE_get_pmc_keyed_str(d
, dest_ns
, key
);
621 if (PMC_IS_NULL(sub_ns
) || sub_ns
->vtable
->base_type
!=
622 enum_class_NameSpace
) {
623 sub_ns
= pmc_new(d
, enum_class_NameSpace
);
624 VTABLE_set_pmc_keyed_str(d
, dest_ns
, key
, sub_ns
);
626 pt_ns_clone(s
, d
, sub_ns
, s
, val
);
629 PMC
* const dval
= VTABLE_get_pmc_keyed_str(d
, dest_ns
, key
);
631 if (PMC_IS_NULL(dval
)) {
632 PMC
* const copy
= make_local_copy(d
, s
, val
);
633 Parrot_Sub_attributes
*val_sub
;
635 if (val
->vtable
->base_type
== enum_class_Sub
)
636 PMC_get_sub(interp
, val
, val_sub
);
638 /* Vtable overrides and methods were already cloned, so don't reclone them. */
639 if (! (val
->vtable
->base_type
== enum_class_Sub
640 && (val_sub
->vtable_index
!= -1
641 || val_sub
->comp_flags
& SUB_COMP_FLAG_METHOD
))) {
642 VTABLE_set_pmc_keyed_str(d
, dest_ns
, key
, copy
);
651 =item C<void pt_clone_globals(Parrot_Interp d, Parrot_Interp s)>
653 Copies the global namespace when cloning a new interpreter.
660 pt_clone_globals(Parrot_Interp d
, Parrot_Interp s
)
662 ASSERT_ARGS(pt_clone_globals
)
663 Parrot_block_GC_mark(d
);
664 pt_ns_clone(s
, d
, d
->root_namespace
, s
, s
->root_namespace
);
665 Parrot_unblock_GC_mark(d
);
670 =item C<void pt_thread_prepare_for_run(Parrot_Interp d, Parrot_Interp s)>
672 Sets up a new thread to run.
679 pt_thread_prepare_for_run(Parrot_Interp d
, SHIM(Parrot_Interp s
))
681 ASSERT_ARGS(pt_thread_prepare_for_run
)
682 Parrot_setup_event_func_ptrs(d
);
689 =head2 ParrotThread methods
699 =item C<PMC * pt_transfer_sub(Parrot_Interp d, Parrot_Interp s, PMC *sub)>
701 Clones the sub so that it's suitable for the other interpreter.
707 PARROT_CAN_RETURN_NULL
709 pt_transfer_sub(ARGOUT(Parrot_Interp d
), ARGIN(Parrot_Interp s
), ARGIN(PMC
*sub
))
711 ASSERT_ARGS(pt_transfer_sub
)
712 #if defined THREAD_DEBUG && THREAD_DEBUG
713 Parrot_io_eprintf(s
, "copying over subroutine [%Ss]\n",
714 Parrot_full_sub_name(s
, sub
));
716 return make_local_copy(d
, s
, sub
);
721 =item C<int pt_thread_run(PARROT_INTERP, PMC *dest_interp, PMC *sub, PMC *arg)>
723 Runs the C<*sub> PMC in a separate thread using the interpreter in
726 C<arg> should be an array of arguments for the subroutine.
733 pt_thread_run(PARROT_INTERP
, ARGOUT(PMC
*dest_interp
), ARGIN(PMC
*sub
), ARGIN_NULLOK(PMC
*arg
))
735 ASSERT_ARGS(pt_thread_run
)
736 PMC
*old_dest_interp
;
738 Interp
* const interpreter
= (Parrot_Interp
)VTABLE_get_pointer(interp
,
741 Parrot_block_GC_sweep(interpreter
);
742 Parrot_block_GC_mark(interpreter
);
743 Parrot_block_GC_sweep(interp
);
744 Parrot_block_GC_mark(interp
);
746 /* make a copy of the ParrotThread PMC so we can use it
747 * to hold parameters to the new thread without it being
748 * garbage collected or otherwise changed by the parent thread.
749 * Also so the new thread's getinterp doesn't return an object
750 * owned by the wrong interpreter -- which would be very bad
751 * if the parent is destroyed before the child.
752 * XXX FIXME move this elsewhere? at least the set_pmc_keyed_int
754 old_dest_interp
= dest_interp
;
755 dest_interp
= pmc_new_noinit(interpreter
, enum_class_ParrotThread
);
757 /* so it's not accidentally deleted */
758 VTABLE_set_pointer(interp
, old_dest_interp
, NULL
);
759 VTABLE_set_pointer(interp
, dest_interp
, interpreter
);
761 VTABLE_set_pmc_keyed_int(interpreter
, interpreter
->iglobals
,
762 (INTVAL
) IGLOBALS_INTERPRETER
, dest_interp
);
764 parent
= VTABLE_get_pmc_keyed_int(interp
, interp
->iglobals
,
765 IGLOBALS_INTERPRETER
);
768 * TODO check if thread flags are consistent
770 if (interp
->flags
& PARROT_THR_COPY_INTERP
)
771 clone_interpreter(interpreter
,
772 (Parrot_Interp
)VTABLE_get_pointer(interp
, parent
),
773 PARROT_CLONE_DEFAULT
);
778 pt_thread_prepare_for_run(interpreter
, interp
);
780 SETATTR_ParrotInterpreter_sub(interp
, dest_interp
,
781 pt_transfer_sub(interpreter
, interp
, sub
));
782 VTABLE_set_pmc(interp
, dest_interp
,
783 make_local_args_copy(interpreter
, interp
, arg
));
786 * set regs according to pdd03
788 interpreter
->current_object
= dest_interp
;
790 * create a joinable thread
792 interpreter
->thread_data
->state
= THREAD_STATE_JOINABLE
;
794 Parrot_unblock_GC_mark(interpreter
);
795 Parrot_unblock_GC_sweep(interpreter
);
796 Parrot_unblock_GC_mark(interp
);
797 Parrot_unblock_GC_sweep(interp
);
799 THREAD_CREATE_JOINABLE(interpreter
->thread_data
->thread
,
800 thread_func
, dest_interp
);
802 /* check for pending GC */
803 LOCK(interpreter_array_mutex
);
804 if (interp
->thread_data
->state
& THREAD_STATE_SUSPEND_GC_REQUESTED
)
805 pt_suspend_one_for_gc(interpreter
);
807 UNLOCK(interpreter_array_mutex
);
813 =item C<int pt_thread_run_1(PARROT_INTERP, PMC* dest_interp, PMC* sub, PMC
816 Runs a thread that shares nothing and does not communicate with the other
824 pt_thread_run_1(PARROT_INTERP
, ARGOUT(PMC
* dest_interp
), ARGIN(PMC
* sub
), ARGIN(PMC
*arg
))
826 ASSERT_ARGS(pt_thread_run_1
)
827 interp
->flags
|= PARROT_THR_TYPE_1
;
828 return pt_thread_run(interp
, dest_interp
, sub
, arg
);
833 =item C<int pt_thread_run_2(PARROT_INTERP, PMC* dest_interp, PMC* sub, PMC
836 Runs an interpreter in a thread with no shared variables, but which
837 communicates by sending messages.
844 pt_thread_run_2(PARROT_INTERP
, ARGOUT(PMC
* dest_interp
), ARGIN(PMC
* sub
), ARGIN(PMC
*arg
))
846 ASSERT_ARGS(pt_thread_run_2
)
847 interp
->flags
|= PARROT_THR_TYPE_2
;
848 return pt_thread_run(interp
, dest_interp
, sub
, arg
);
853 =item C<int pt_thread_run_3(PARROT_INTERP, PMC* dest_interp, PMC* sub, PMC
856 Runs an interpreter in a thread, allowing shared variables and using a thread
864 pt_thread_run_3(PARROT_INTERP
, ARGOUT(PMC
* dest_interp
), ARGIN(PMC
* sub
), ARGIN(PMC
*arg
))
866 ASSERT_ARGS(pt_thread_run_3
)
867 interp
->flags
|= PARROT_THR_TYPE_3
;
868 return pt_thread_run(interp
, dest_interp
, sub
, arg
);
873 =item C<void pt_thread_yield(void)>
875 Relinquishes hold on the processor.
882 pt_thread_yield(void)
884 ASSERT_ARGS(pt_thread_yield
)
890 =item C<static Parrot_Interp pt_check_tid(UINTVAL tid, const char *from)>
892 Helper function. Checks if the given thread ID is valid. The caller holds the
893 mutex. Returns the interpreter for C<tid>.
900 pt_check_tid(UINTVAL tid
, ARGIN(const char *from
))
902 ASSERT_ARGS(pt_check_tid
)
903 if (tid
>= n_interpreters
) {
904 UNLOCK(interpreter_array_mutex
);
905 exit_fatal(1, "%s: illegal thread tid %d", from
, tid
);
908 UNLOCK(interpreter_array_mutex
);
909 exit_fatal(1, "%s: illegal thread tid %d (main)", from
, tid
);
911 if (!interpreter_array
[tid
]) {
912 UNLOCK(interpreter_array_mutex
);
913 exit_fatal(1, "%s: illegal thread tid %d - empty", from
, tid
);
915 return interpreter_array
[tid
];
920 =item C<static void mutex_unlock(void *arg)>
922 Unlocks the mutex C<*arg>.
929 mutex_unlock(ARGMOD(void *arg
))
931 ASSERT_ARGS(mutex_unlock
)
932 UNLOCK(*(Parrot_mutex
*) arg
);
937 =item C<static int is_suspended_for_gc(PARROT_INTERP)>
939 Returns true iff C<interp> is suspended for a global GC run. Be sure to hold
940 C<interpreter_array_mutex>.
946 PARROT_WARN_UNUSED_RESULT
948 is_suspended_for_gc(PARROT_INTERP
)
950 ASSERT_ARGS(is_suspended_for_gc
)
953 else if (interp
->thread_data
->wants_shared_gc
)
955 else if (interp
->thread_data
->state
& THREAD_STATE_SUSPENDED_GC
)
957 else if ((interp
->thread_data
->state
& THREAD_STATE_FINISHED
) ||
958 (interp
->thread_data
->state
& THREAD_STATE_NOT_STARTED
))
966 =item C<static QUEUE_ENTRY * remove_queued_suspend_gc(PARROT_INTERP)>
968 Removes an event requesting that the interpreter suspend itself for a
969 garbage-collection run from the event queue.
975 PARROT_CAN_RETURN_NULL
977 remove_queued_suspend_gc(PARROT_INTERP
)
979 ASSERT_ARGS(remove_queued_suspend_gc
)
980 parrot_event
*ev
= NULL
;
981 QUEUE
* const queue
= interp
->task_queue
;
982 QUEUE_ENTRY
*prev
= NULL
;
989 ev
= (parrot_event
*)cur
->data
;
991 if (ev
->type
== EVENT_TYPE_SUSPEND_FOR_GC
)
1000 prev
->next
= cur
->next
;
1002 queue
->head
= cur
->next
;
1004 if (cur
== queue
->tail
)
1007 if (cur
== queue
->head
)
1008 queue
->head
= cur
->next
;
1013 DEBUG_ONLY(fprintf(stderr
, "%p: remove_queued_suspend_gc: got one\n", interp
));
1016 queue_unlock(queue
);
1022 =item C<static int pt_gc_count_threads(PARROT_INTERP)>
1024 Returns the number of active threads in the system (running or suspended). Be
1025 sure to hold C<interpreter_array_mutex>.
1032 pt_gc_count_threads(PARROT_INTERP
)
1034 ASSERT_ARGS(pt_gc_count_threads
)
1038 for (i
= 0; i
< n_interpreters
; ++i
) {
1040 cur
= interpreter_array
[i
];
1043 if (cur
->thread_data
->state
& (THREAD_STATE_NOT_STARTED
|
1044 THREAD_STATE_FINISHED
))
1048 DEBUG_ONLY(fprintf(stderr
, "found %d threads\n", count
));
1054 =item C<static void pt_gc_wait_for_stage(PARROT_INTERP, thread_gc_stage_enum
1055 from_stage, thread_gc_stage_enum to_stage)>
1057 Waits until all threads have reached the desired stage. Takes an interpreter,
1058 starting stage and ending stage as arguments. Updates the thread information.
1059 Used in C<pt_gc_start_mark> and C<pt_gc_stop_mark>.
1066 pt_gc_wait_for_stage(PARROT_INTERP
, thread_gc_stage_enum from_stage
,
1067 thread_gc_stage_enum to_stage
)
1069 ASSERT_ARGS(pt_gc_wait_for_stage
)
1070 Shared_gc_info
* const info
= shared_gc_info
;
1073 DEBUG_ONLY(fprintf(stderr
, "%p: gc_wait_for_stage: %d->%d\n", interp
, from_stage
, to_stage
));
1075 /* XXX well-timed thread death can mess this up */
1076 LOCK(interpreter_array_mutex
);
1078 DEBUG_ONLY(fprintf(stderr
, "%p: got lock\n", interp
));
1079 thread_count
= pt_gc_count_threads(interp
);
1081 PARROT_ASSERT(info
->gc_stage
== from_stage
);
1082 PARROT_ASSERT(!(interp
->thread_data
->state
& THREAD_STATE_NOT_STARTED
));
1083 PARROT_ASSERT(!(interp
->thread_data
->state
& THREAD_STATE_FINISHED
));
1085 if (from_stage
== 0)
1086 PARROT_ASSERT(interp
->thread_data
->state
& THREAD_STATE_SUSPENDED_GC
);
1088 PARROT_ASSERT(!(interp
->thread_data
->state
& THREAD_STATE_SUSPENDED_GC
));
1090 ++info
->num_reached
;
1092 DEBUG_ONLY(fprintf(stderr
, "%p: gc_wait_for_stage: got %d\n", interp
, info
->num_reached
));
1094 if (info
->num_reached
== thread_count
) {
1095 info
->gc_stage
= to_stage
;
1096 info
->num_reached
= 0;
1097 COND_BROADCAST(info
->gc_cond
);
1101 COND_WAIT(info
->gc_cond
, interpreter_array_mutex
);
1102 } while (info
->gc_stage
!= to_stage
);
1104 UNLOCK(interpreter_array_mutex
);
1110 =item C<static void pt_gc_wakeup_check(PARROT_INTERP)>
1112 Checks if it's necessary to wake threads to perform garbage collection. This
1113 is called after thread death. Be sure to hold C<interpreter_array_mutex>.
1120 pt_gc_wakeup_check(PARROT_INTERP
)
1122 ASSERT_ARGS(pt_gc_wakeup_check
)
1123 Shared_gc_info
* const info
= shared_gc_info
;
1126 /* XXX: maybe a little hack; see RT #49532 */
1130 thread_count
= pt_gc_count_threads(interp
);
1132 if (info
->num_reached
== thread_count
) {
1133 PARROT_ASSERT(info
->gc_stage
== THREAD_GC_STAGE_NONE
);
1134 info
->gc_stage
= THREAD_GC_STAGE_MARK
;
1135 info
->num_reached
= 0;
1136 COND_BROADCAST(info
->gc_cond
);
1142 =item C<static void pt_suspend_one_for_gc(PARROT_INTERP)>
1144 Suspends a single interpreter for GC. Be sure to hold
1145 C<interpreter_array_mutex>.
1152 pt_suspend_one_for_gc(PARROT_INTERP
)
1154 ASSERT_ARGS(pt_suspend_one_for_gc
)
1155 DEBUG_ONLY(fprintf(stderr
, "suspend one: %p\n", interp
));
1156 if (is_suspended_for_gc(interp
)) {
1157 DEBUG_ONLY(fprintf(stderr
, "ignoring already suspended\n"));
1161 if (interp
->thread_data
->state
& THREAD_STATE_GC_WAKEUP
) {
1162 DEBUG_ONLY(fprintf(stderr
, "just waking it up\n"));
1163 interp
->thread_data
->state
|= THREAD_STATE_SUSPENDED_GC
;
1164 COND_SIGNAL(interp
->thread_data
->interp_cond
);
1167 DEBUG_ONLY(fprintf(stderr
, "queuing event\n"));
1168 interp
->thread_data
->state
|= THREAD_STATE_SUSPEND_GC_REQUESTED
;
1169 Parrot_cx_request_suspend_for_gc(interp
);
1175 =item C<static void pt_suspend_all_for_gc(PARROT_INTERP)>
1177 Notifies all threads to perform a GC run.
1184 pt_suspend_all_for_gc(PARROT_INTERP
)
1186 ASSERT_ARGS(pt_suspend_all_for_gc
)
1189 DEBUG_ONLY(fprintf(stderr
, "suspend_all_for_gc [interp=%p]\n", interp
));
1191 LOCK(interpreter_array_mutex
);
1192 interp
->thread_data
->state
|= THREAD_STATE_SUSPENDED_GC
;
1194 if (interp
->thread_data
->state
& THREAD_STATE_SUSPEND_GC_REQUESTED
) {
1195 DEBUG_ONLY(fprintf(stderr
, "found while suspending all\n"));
1196 Parrot_cx_delete_suspend_for_gc(interp
);
1197 interp
->thread_data
->state
&= ~THREAD_STATE_SUSPEND_GC_REQUESTED
;
1198 UNLOCK(interpreter_array_mutex
);
1203 for (i
= 0; i
< n_interpreters
; ++i
) {
1204 Parrot_Interp other_interp
;
1205 other_interp
= interpreter_array
[i
];
1209 if (is_suspended_for_gc(other_interp
) &&
1210 other_interp
!= interp
&&
1211 (other_interp
->thread_data
->state
& THREAD_STATE_SUSPENDED_GC
))
1214 /* this means that someone else already got this far,
1215 * so we have a suspend event in our queue to ignore
1217 /* XXX still reachable? */
1218 DEBUG_ONLY(fprintf(stderr
, "apparently someone else is doing it [%p]\n", other_interp
));
1219 fprintf(stderr
, "??? found later (%p)\n", other_interp
);
1220 successp
= Parrot_cx_delete_suspend_for_gc(interp
);
1221 PARROT_ASSERT(successp
);
1222 UNLOCK(interpreter_array_mutex
);
1228 /* now send all the non-suspended threads to suspend for GC */
1229 for (i
= 0; i
< n_interpreters
; ++i
) {
1230 Parrot_Interp other_interp
= interpreter_array
[i
];
1232 if (interp
== other_interp
)
1235 if (is_suspended_for_gc(other_interp
))
1238 pt_suspend_one_for_gc(other_interp
);
1240 UNLOCK(interpreter_array_mutex
);
1245 =item C<void pt_suspend_self_for_gc(PARROT_INTERP)>
1247 Suspends this thread for a full GC run.
1249 XXX FIXME -- if GC is blocked, we need to do a GC run as soon
1250 as it becomes unblocked.
1257 pt_suspend_self_for_gc(PARROT_INTERP
)
1259 ASSERT_ARGS(pt_suspend_self_for_gc
)
1260 PARROT_ASSERT(interp
);
1261 PARROT_ASSERT(!Parrot_is_blocked_GC_mark(interp
));
1262 DEBUG_ONLY(fprintf(stderr
, "%p: suspend_self_for_gc\n", interp
));
1263 /* since we are modifying our own state, we need to lock
1264 * the interpreter_array_mutex.
1266 LOCK(interpreter_array_mutex
);
1267 DEBUG_ONLY(fprintf(stderr
, "%p: got lock\n", interp
));
1269 PARROT_ASSERT(interp
->thread_data
->state
&
1270 (THREAD_STATE_SUSPEND_GC_REQUESTED
| THREAD_STATE_SUSPENDED_GC
));
1272 if (interp
->thread_data
->state
& THREAD_STATE_SUSPEND_GC_REQUESTED
) {
1273 DEBUG_ONLY(fprintf(stderr
, "remove queued request\n"));
1274 while (!PMC_IS_NULL(Parrot_cx_delete_suspend_for_gc(interp
))) {/*Empty body*/};
1275 DEBUG_ONLY(fprintf(stderr
, "removed all queued requests\n"));
1276 interp
->thread_data
->state
&= ~THREAD_STATE_SUSPEND_GC_REQUESTED
;
1278 if (!(interp
->thread_data
->state
& THREAD_STATE_SUSPENDED_GC
)) {
1279 interp
->thread_data
->state
|= THREAD_STATE_SUSPENDED_GC
;
1282 DEBUG_ONLY(fprintf(stderr
, "no need to set suspended\n"));
1284 UNLOCK(interpreter_array_mutex
);
1286 /* mark and sweep our world -- later callbacks will keep
1289 Parrot_gc_mark_and_sweep(interp
, GC_trace_stack_FLAG
);
1291 PARROT_ASSERT(!(interp
->thread_data
->state
& THREAD_STATE_SUSPENDED_GC
));
1296 =item C<PMC* pt_thread_join(Parrot_Interp parent, UINTVAL tid)>
1298 Joins (by waiting for) a joinable thread.
1304 PARROT_CAN_RETURN_NULL
1306 pt_thread_join(NOTNULL(Parrot_Interp parent
), UINTVAL tid
)
1308 ASSERT_ARGS(pt_thread_join
)
1310 Parrot_Interp interp
;
1312 LOCK(interpreter_array_mutex
);
1314 interp
= pt_check_tid(tid
, "join");
1316 if (interp
== parent
)
1317 do_panic(parent
, "Can't join self", __FILE__
, __LINE__
);
1319 if ((!(interp
->thread_data
->state
& (THREAD_STATE_DETACHED
1320 | THREAD_STATE_JOINED
)) &&
1321 !(interp
->thread_data
->state
& THREAD_STATE_NOT_STARTED
)) ||
1322 interp
->thread_data
->state
== THREAD_STATE_FINISHED
) {
1323 void *raw_retval
= NULL
;
1326 interp
->thread_data
->state
|= THREAD_STATE_JOINED
;
1328 while (!(interp
->thread_data
->state
& THREAD_STATE_FINISHED
)) {
1329 interp
->thread_data
->joiner
= parent
;
1330 pt_thread_wait(parent
);
1333 UNLOCK(interpreter_array_mutex
);
1334 JOIN(interp
->thread_data
->thread
, raw_retval
);
1336 retval
= (PMC
*)raw_retval
;
1338 * we need to push a cleanup handler here: if cloning
1339 * of the retval fails (e.g. it's a NULLPMC) this lock
1340 * isn't released until eternity or someone hits ^C
1342 * TODO This is needed for all places holding a lock for
1345 * TODO remove that and replace it with proper exception
1346 * handling, so that a failing clone in the parent
1347 * just stops that thread
1350 LOCK(interpreter_array_mutex
);
1351 CLEANUP_PUSH(mutex_unlock
, &interpreter_array_mutex
);
1356 * clone the PMC into caller, if it's not a shared PMC
1357 * the PMC is not in the parents root set nor in the
1358 * stack so block GC during clone
1359 * XXX should probably acquire the parent's interpreter mutex
1361 Parrot_block_GC_mark(parent
);
1362 parent_ret
= make_local_copy(parent
, interp
, retval
);
1364 /* this PMC is living only in the stack of this currently
1365 * dying interpreter, so register it in parent's GC registry
1366 * XXX is this still needed?
1368 gc_register_pmc(parent
, parent_ret
);
1369 Parrot_unblock_GC_mark(parent
);
1370 retval
= parent_ret
;
1375 interpreter_array
[tid
] = NULL
;
1378 DEBUG_ONLY(fprintf(stderr
, "destroying an interpreter [join]\n"));
1379 if (Interp_debug_TEST(parent
, PARROT_THREAD_DEBUG_FLAG
))
1380 fprintf(stderr
, "running threads %d\n", running_threads
);
1382 /* reparent it so memory pool merging works */
1383 interp
->parent_interpreter
= parent
;
1384 Parrot_really_destroy(interp
, 0, NULL
);
1388 * interpreter destruction is done - unregister the return
1389 * value, caller gets it now
1392 gc_unregister_pmc(parent
, retval
);
1397 * when here thread was in wrong state
1399 state
= interp
->thread_data
->state
;
1400 UNLOCK(interpreter_array_mutex
);
1401 Parrot_ex_throw_from_c_args(interp
, NULL
, 1,
1402 "join: illegal thread state %d tid %d", state
, tid
);
1407 =item C<void pt_join_threads(PARROT_INTERP)>
1409 Possibly waits for other running threads. This is called when destroying
1417 pt_join_threads(PARROT_INTERP
)
1419 ASSERT_ARGS(pt_join_threads
)
1421 pt_free_pool(interp
);
1423 /* if no threads were started - fine */
1424 LOCK(interpreter_array_mutex
);
1425 if (n_interpreters
<= 1) {
1427 UNLOCK(interpreter_array_mutex
);
1431 /* only the first interpreter waits for other threads */
1432 if (interp
!= interpreter_array
[0]) {
1433 UNLOCK(interpreter_array_mutex
);
1437 for (i
= 1; i
< n_interpreters
; ++i
) {
1438 Parrot_Interp thread_interp
= interpreter_array
[i
];
1439 if (thread_interp
== NULL
)
1441 if (thread_interp
->thread_data
->state
== THREAD_STATE_JOINABLE
||
1442 (thread_interp
->thread_data
->state
& THREAD_STATE_FINISHED
)) {
1444 void *retval
= NULL
;
1445 thread_interp
->thread_data
->state
|= THREAD_STATE_JOINED
;
1446 UNLOCK(interpreter_array_mutex
);
1447 JOIN(thread_interp
->thread_data
->thread
, retval
);
1448 LOCK(interpreter_array_mutex
);
1451 UNLOCK(interpreter_array_mutex
);
1457 =item C<static Parrot_Interp detach(UINTVAL tid)>
1459 Helper for detach and kill.
1461 Returns the interpreter, if it didn't finish yet.
1467 static Parrot_Interp
1471 Parrot_Interp interp
;
1473 LOCK(interpreter_array_mutex
);
1474 interp
= pt_check_tid(tid
, "detach");
1476 * if interpreter is joinable, we detach em
1478 if (interp
->thread_data
->state
== THREAD_STATE_JOINABLE
||
1479 interp
->thread_data
->state
== THREAD_STATE_FINISHED
) {
1480 DETACH(interp
->thread_data
->thread
);
1481 interp
->thread_data
->state
|= THREAD_STATE_DETACHED
;
1483 if (interp
->thread_data
->state
& THREAD_STATE_FINISHED
) {
1484 interpreter_array
[tid
] = NULL
;
1485 DEBUG_ONLY(fprintf(stderr
, "destroying an interpreter [detach]\n"));
1486 Parrot_really_destroy(interp
, 0, NULL
);
1490 UNLOCK(interpreter_array_mutex
);
1496 =item C<void pt_thread_detach(UINTVAL tid)>
1498 Detaches the thread, making it non-joinable.
1505 pt_thread_detach(UINTVAL tid
)
1507 ASSERT_ARGS(pt_thread_detach
)
1513 =item C<void pt_thread_kill(UINTVAL tid)>
1522 pt_thread_kill(UINTVAL tid
)
1524 ASSERT_ARGS(pt_thread_kill
)
1525 PARROT_INTERP
= detach(tid
);
1527 /* schedule a terminate event for that interpreter */
1529 Parrot_cx_runloop_end(interp
);
1536 =head2 Threaded interpreter book-keeping
1540 =item C<void pt_add_to_interpreters(PARROT_INTERP, Parrot_Interp new_interp)>
1542 Stores the given interpreter in the array of all interpreters. Be sure to hold
1543 C<interpreter_array_mutex>.
1550 pt_add_to_interpreters(PARROT_INTERP
, ARGIN_NULLOK(Parrot_Interp new_interp
))
1552 ASSERT_ARGS(pt_add_to_interpreters
)
1554 DEBUG_ONLY(fprintf(stderr
, "interp = %p\n", interp
));
1558 * Create an entry for the very first interpreter, event
1561 PARROT_ASSERT(!interpreter_array
);
1562 PARROT_ASSERT(n_interpreters
== 0);
1564 interpreter_array
= mem_allocate_typed(Interp
*);
1565 interpreter_array
[0] = interp
;
1568 shared_gc_info
= (Shared_gc_info
*)mem_sys_allocate_zeroed(sizeof (*shared_gc_info
));
1569 COND_INIT(shared_gc_info
->gc_cond
);
1570 PARROT_ATOMIC_INT_INIT(shared_gc_info
->gc_block_level
);
1571 PARROT_ATOMIC_INT_SET(shared_gc_info
->gc_block_level
, 0);
1573 /* XXX try to defer this until later */
1574 PARROT_ASSERT(interp
== interpreter_array
[0]);
1575 interp
->thread_data
= mem_allocate_zeroed_typed(Thread_data
);
1576 INTERPRETER_LOCK_INIT(interp
);
1577 interp
->thread_data
->tid
= 0;
1583 new_interp
->thread_data
= mem_allocate_zeroed_typed(Thread_data
);
1584 INTERPRETER_LOCK_INIT(new_interp
);
1586 if (Interp_debug_TEST(interp
, PARROT_THREAD_DEBUG_FLAG
))
1587 fprintf(stderr
, "running threads %d\n", running_threads
);
1589 /* look for an empty slot */
1590 for (i
= 0; i
< n_interpreters
; ++i
) {
1591 if (interpreter_array
[i
] == NULL
) {
1592 interpreter_array
[i
] = new_interp
;
1593 new_interp
->thread_data
->tid
= i
;
1594 new_interp
->thread_data
->state
= THREAD_STATE_NOT_STARTED
;
1599 /* need to resize */
1600 interpreter_array
= (Interp
**)mem_sys_realloc(interpreter_array
,
1601 (n_interpreters
+ 1) * sizeof (Interp
*));
1603 interpreter_array
[n_interpreters
] = new_interp
;
1604 new_interp
->thread_data
->tid
= n_interpreters
;
1605 new_interp
->thread_data
->state
= THREAD_STATE_NOT_STARTED
;
1614 =head2 GC Synchronization Functions
1618 =item C<void pt_gc_start_mark(PARROT_INTERP)>
1620 Record that the mark phase of GC is about to begin. In the presence of shared
1621 PMCs, we can only run one GC run at a time.
1623 C<flags> are the GC flags. We check if we need to collect shared objects or
1626 TODO - Have a count of shared PMCs and check it during GC.
1628 TODO - Evaluate if a interpreter lock is cheaper when C<gc_mark_ptr> is
1636 pt_gc_start_mark(PARROT_INTERP
)
1638 ASSERT_ARGS(pt_gc_start_mark
)
1639 Shared_gc_info
*info
;
1642 DEBUG_ONLY(fprintf(stderr
, "%p: pt_gc_start_mark\n", interp
));
1643 /* if no other threads are running, we are safe */
1644 if (!running_threads
)
1647 info
= get_pool(interp
);
1648 PARROT_ATOMIC_INT_GET(block_level
, info
->gc_block_level
);
1650 DEBUG_ONLY(fprintf(stderr
, "start threaded mark\n"));
1652 * TODO now check, if we are the owner of a shared memory pool
1654 * - suspend all other threads by sending them a suspend event
1655 * (or put a LOCK around updating the mark pointers)
1656 * - return and continue the mark phase
1657 * - then s. comments below
1659 LOCK(interpreter_array_mutex
);
1660 if (interp
->thread_data
->state
& THREAD_STATE_SUSPENDED_GC
) {
1661 PARROT_ASSERT(!(interp
->thread_data
->state
&
1662 THREAD_STATE_SUSPEND_GC_REQUESTED
));
1663 DEBUG_ONLY(fprintf(stderr
, "already suspended...\n"));
1664 UNLOCK(interpreter_array_mutex
);
1666 else if (block_level
) {
1667 /* unthreaded collection */
1668 DEBUG_ONLY(fprintf(stderr
, "... but blocked\n"));
1670 /* holding the lock */
1673 else if (interp
->thread_data
->state
&
1674 THREAD_STATE_SUSPEND_GC_REQUESTED
) {
1675 while (!PMC_IS_NULL(Parrot_cx_delete_suspend_for_gc(interp
))) {/*Empty body*/};
1677 interp
->thread_data
->state
&= ~THREAD_STATE_SUSPEND_GC_REQUESTED
;
1678 interp
->thread_data
->state
|= THREAD_STATE_SUSPENDED_GC
;
1680 DEBUG_ONLY(fprintf(stderr
, "%p: detected request\n", interp
));
1681 UNLOCK(interpreter_array_mutex
);
1684 /* we need to stop the world */
1685 DEBUG_ONLY(fprintf(stderr
, "stop the world\n"));
1686 UNLOCK(interpreter_array_mutex
);
1688 pt_suspend_all_for_gc(interp
);
1691 DEBUG_ONLY(fprintf(stderr
, "%p: wait for stage\n", interp
));
1692 pt_gc_wait_for_stage(interp
, THREAD_GC_STAGE_NONE
, THREAD_GC_STAGE_MARK
);
1694 DEBUG_ONLY(fprintf(stderr
, "actually mark\n"));
1696 * We can't allow parallel running GCs.
1698 LOCK(interpreter_array_mutex
);
1699 DEBUG_ONLY(fprintf(stderr
, "got marking lock\n"));
1704 =item C<void pt_gc_mark_root_finished(PARROT_INTERP)>
1706 Records that GC has finished for the root set. EXCEPTION_UNIMPLEMENTED
1713 pt_gc_mark_root_finished(PARROT_INTERP
)
1715 ASSERT_ARGS(pt_gc_mark_root_finished
)
1716 if (!running_threads
)
1719 * TODO now check, if we are the owner of a shared memory pool
1721 * - now mark all members of our pool
1722 * - if all shared PMCs are marked by all threads then
1723 * - we can continue to free unused objects
1729 =item C<void pt_gc_stop_mark(PARROT_INTERP)>
1731 Records that the mark phase of GC has completed.
1738 pt_gc_stop_mark(PARROT_INTERP
)
1740 ASSERT_ARGS(pt_gc_stop_mark
)
1741 if (!running_threads
)
1744 * normal operation can continue now
1745 * - other threads may or not free unused objects then,
1746 * depending on their resource statistics
1748 if (!(interp
->thread_data
->state
& THREAD_STATE_SUSPENDED_GC
)) {
1749 UNLOCK(interpreter_array_mutex
);
1753 PARROT_ASSERT(!(interp
->thread_data
->state
&
1754 THREAD_STATE_SUSPEND_GC_REQUESTED
));
1755 interp
->thread_data
->state
&= ~THREAD_STATE_SUSPENDED_GC
;
1757 while (!PMC_IS_NULL(Parrot_cx_delete_suspend_for_gc(interp
))) {
1758 /* XXX FIXME make this message never trigger */
1759 fprintf(stderr
, "%p: extraneous suspend_gc event\n", (void *)interp
);
1762 DEBUG_ONLY(fprintf(stderr
, "%p: unlock\n", interp
));
1763 UNLOCK(interpreter_array_mutex
);
1764 DEBUG_ONLY(fprintf(stderr
, "wait to sweep\n"));
1766 pt_gc_wait_for_stage(interp
, THREAD_GC_STAGE_MARK
, THREAD_GC_STAGE_SWEEP
);
1771 =item C<void Parrot_shared_gc_block(PARROT_INTERP)>
1773 Blocks stop-the-world GC runs.
1781 Parrot_shared_gc_block(PARROT_INTERP
)
1783 ASSERT_ARGS(Parrot_shared_gc_block
)
1784 Shared_gc_info
* const info
= get_pool(interp
);
1788 PARROT_ATOMIC_INT_INC(level
, info
->gc_block_level
);
1789 PARROT_ASSERT(level
> 0);
1795 =item C<void Parrot_shared_gc_unblock(PARROT_INTERP)>
1797 Unblocks stop-the-world GC runs.
1805 Parrot_shared_gc_unblock(PARROT_INTERP
)
1807 ASSERT_ARGS(Parrot_shared_gc_unblock
)
1808 Shared_gc_info
* const info
= get_pool(interp
);
1811 PARROT_ATOMIC_INT_DEC(level
, info
->gc_block_level
);
1812 PARROT_ASSERT(level
>= 0);
1818 * c-file-style: "parrot"
1820 * vim: expandtab shiftwidth=4: