[svn:parrot] r48297 - in branches/gsoc_threads: . include/parrot include/parrot/oplib src src/interp src/ops src/pmc t/native_pbc t/pmc
Chandon at svn.parrot.org
Chandon at svn.parrot.org
Tue Aug 3 21:57:35 UTC 2010
Author: Chandon
Date: Tue Aug 3 21:57:34 2010
New Revision: 48297
URL: https://trac.parrot.org/parrot/changeset/48297
Log:
[gsoc_threads] Kill ParrotThread and some other dead code.
Added:
branches/gsoc_threads/DEPRECATED-branch.pod
branches/gsoc_threads/src/pmc/poolthread.pmc
Deleted:
branches/gsoc_threads/src/pmc/event.pmc
branches/gsoc_threads/src/pmc/parrotthread.pmc
branches/gsoc_threads/t/pmc/event.t
branches/gsoc_threads/t/pmc/parrotthread.t
branches/gsoc_threads/t/pmc/scheduler.t
branches/gsoc_threads/t/pmc/threads.t
Modified:
branches/gsoc_threads/MANIFEST
branches/gsoc_threads/include/parrot/interpreter.h
branches/gsoc_threads/include/parrot/oplib/core_ops.h
branches/gsoc_threads/include/parrot/oplib/ops.h
branches/gsoc_threads/include/parrot/opsenum.h
branches/gsoc_threads/src/events.c
branches/gsoc_threads/src/interp/inter_create.c
branches/gsoc_threads/src/ops/core.ops
branches/gsoc_threads/src/ops/core_ops.c
branches/gsoc_threads/src/ops/experimental.ops
branches/gsoc_threads/src/packfile.c
branches/gsoc_threads/src/pmc/parrotinterpreter.pmc
branches/gsoc_threads/src/pmc/pmclist.pmc
branches/gsoc_threads/src/pmc/scheduler.pmc
branches/gsoc_threads/t/native_pbc/annotations.pbc
branches/gsoc_threads/t/native_pbc/integer.pbc
branches/gsoc_threads/t/native_pbc/number.pbc
branches/gsoc_threads/t/native_pbc/string.pbc
branches/gsoc_threads/t/pmc/task.t
branches/gsoc_threads/t/pmc/task_primes.t
Added: branches/gsoc_threads/DEPRECATED-branch.pod
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/gsoc_threads/DEPRECATED-branch.pod Tue Aug 3 21:57:34 2010 (r48297)
@@ -0,0 +1,25 @@
+# $Id$
+
+=head1 Purpose
+
+This is a list of things that have changed in this branch. These
+things may or may not require notices and a deprication cycle before
+this branch can be merged.
+
+=head1 ITEMS
+
+=head1 Events
+
+Events have been removed. This primarily means the old Task PMC. They
+were never fully implemented to begin with, and the behavior can be
+created in applications using (new) Tasks, message passing, and multiple
+dispatch.
+
+=head1 ParrotThread
+
+ParrotThread is gone. If you want threads, you'll have to schedule some
+Task PMCs.
+
+=head1
+
+=cut
Modified: branches/gsoc_threads/MANIFEST
==============================================================================
--- branches/gsoc_threads/MANIFEST Tue Aug 3 19:11:36 2010 (r48296)
+++ branches/gsoc_threads/MANIFEST Tue Aug 3 21:57:34 2010 (r48297)
@@ -1371,7 +1371,6 @@
src/pmc/default.pmc []
src/pmc/env.pmc []
src/pmc/eval.pmc []
-src/pmc/eventhandler.pmc []
src/pmc/exception.pmc []
src/pmc/exceptionhandler.pmc []
src/pmc/exporter.pmc []
@@ -1416,7 +1415,6 @@
src/pmc/packfilesegment.pmc []
src/pmc/parrotinterpreter.pmc []
src/pmc/parrotlibrary.pmc []
-src/pmc/parrotthread.pmc []
src/pmc/pmc.num []
src/pmc/pmclist.pmc []
src/pmc/pmcproxy.pmc []
@@ -1930,7 +1928,6 @@
t/pmc/parrotio.t [test]
t/pmc/parrotlibrary.t [test]
t/pmc/parrotobject.t [test]
-t/pmc/parrotthread.t [test]
t/pmc/pmc.t [test]
t/pmc/pmclist.t [test]
t/pmc/pmcproxy.t [test]
@@ -1944,7 +1941,6 @@
t/pmc/ro.t [test]
t/pmc/role.t [test]
t/pmc/scalar.t [test]
-t/pmc/scheduler.t [test]
t/pmc/schedulermessage.t [test]
t/pmc/signal.t [test]
t/pmc/sockaddr.t [test]
@@ -1957,7 +1953,6 @@
t/pmc/sys.t [test]
t/pmc/task.t [test]
t/pmc/testlib/packfile_common.pir [test]
-t/pmc/threads.t [test]
t/pmc/timer.t [test]
t/pmc/undef.t [test]
t/pmc/unmanagedstruct.t [test]
Modified: branches/gsoc_threads/include/parrot/interpreter.h
==============================================================================
--- branches/gsoc_threads/include/parrot/interpreter.h Tue Aug 3 19:11:36 2010 (r48296)
+++ branches/gsoc_threads/include/parrot/interpreter.h Tue Aug 3 21:57:34 2010 (r48297)
@@ -259,7 +259,6 @@
STRING **const_cstring_table; /* CONST_STRING(x) items */
Hash *const_cstring_hash; /* cache of const_string items */
- struct QUEUE* task_queue; /* per interpreter queue */
struct _handler_node_t *exit_handler_list;/* exit.c */
int sleeping; /* used during sleep in events */
@@ -271,7 +270,11 @@
UINTVAL last_alarm; /* has an alarm triggered? */
FLOATVAL quantum_done; /* expiration of current quantum */
- PMC *current_task;
+ PMC *current_task; /* there's always one running task */
+
+ PMC *thread_pool; /* All threads assigned to this interp */
+ INTVAL blocked_count; /* Number of threads currently blocked */
+ Parrot_mutex interp_lock; /* Enforce one running thread per interp */
struct _Thread_data *thread_data; /* thread specific items */
Modified: branches/gsoc_threads/include/parrot/oplib/core_ops.h
==============================================================================
--- branches/gsoc_threads/include/parrot/oplib/core_ops.h Tue Aug 3 19:11:36 2010 (r48296)
+++ branches/gsoc_threads/include/parrot/oplib/core_ops.h Tue Aug 3 21:57:34 2010 (r48297)
@@ -1105,7 +1105,7 @@
opcode_t * Parrot_find_codepoint_i_sc(opcode_t *, PARROT_INTERP);
opcode_t * Parrot_finalize_p(opcode_t *, PARROT_INTERP);
opcode_t * Parrot_finalize_pc(opcode_t *, PARROT_INTERP);
- opcode_t * Parrot_recv_p(opcode_t *, PARROT_INTERP);
+ opcode_t * Parrot_receive_p(opcode_t *, PARROT_INTERP);
opcode_t * Parrot_wait_p(opcode_t *, PARROT_INTERP);
opcode_t * Parrot_wait_pc(opcode_t *, PARROT_INTERP);
opcode_t * Parrot_pass(opcode_t *, PARROT_INTERP);
Modified: branches/gsoc_threads/include/parrot/oplib/ops.h
==============================================================================
--- branches/gsoc_threads/include/parrot/oplib/ops.h Tue Aug 3 19:11:36 2010 (r48296)
+++ branches/gsoc_threads/include/parrot/oplib/ops.h Tue Aug 3 21:57:34 2010 (r48297)
@@ -1100,7 +1100,7 @@
PARROT_OP_find_codepoint_i_sc, /* 1080 */
PARROT_OP_finalize_p, /* 1081 */
PARROT_OP_finalize_pc, /* 1082 */
- PARROT_OP_recv_p, /* 1083 */
+ PARROT_OP_receive_p, /* 1083 */
PARROT_OP_wait_p, /* 1084 */
PARROT_OP_wait_pc, /* 1085 */
PARROT_OP_pass /* 1086 */
Modified: branches/gsoc_threads/include/parrot/opsenum.h
==============================================================================
--- branches/gsoc_threads/include/parrot/opsenum.h Tue Aug 3 19:11:36 2010 (r48296)
+++ branches/gsoc_threads/include/parrot/opsenum.h Tue Aug 3 21:57:34 2010 (r48297)
@@ -1099,7 +1099,7 @@
enum_ops_find_codepoint_i_sc = 1080,
enum_ops_finalize_p = 1081,
enum_ops_finalize_pc = 1082,
- enum_ops_recv_p = 1083,
+ enum_ops_receive_p = 1083,
enum_ops_wait_p = 1084,
enum_ops_wait_pc = 1085,
enum_ops_pass = 1086,
Modified: branches/gsoc_threads/src/events.c
==============================================================================
--- branches/gsoc_threads/src/events.c Tue Aug 3 19:11:36 2010 (r48296)
+++ branches/gsoc_threads/src/events.c Tue Aug 3 21:57:34 2010 (r48297)
@@ -23,47 +23,7 @@
/* HEADERIZER HFILE: include/parrot/events.h */
-
-
-#ifdef PARROT_CX_BUILD_OLD_STUFF
- Parrot_cx_refresh_task_list(interp, scheduler);
-
- while (VTABLE_get_integer(interp, scheduler) > 0) {
- PMC * const task = VTABLE_pop_pmc(interp, scheduler);
- if (!PMC_IS_NULL(task)) {
- PMC * const type_pmc = VTABLE_get_attr_str(interp, task, CONST_STRING(interp, "type"));
- STRING * const type = VTABLE_get_string(interp, type_pmc);
-
- if (Parrot_str_equal(interp, type, CONST_STRING(interp, "callback"))) {
- Parrot_cx_invoke_callback(interp, task);
- }
- else if (Parrot_str_equal(interp, type, CONST_STRING(interp, "timer"))) {
- Parrot_cx_timer_invoke(interp, task);
- }
- else if (Parrot_str_equal(interp, type, CONST_STRING(interp, "event"))) {
- PMC * const handler = Parrot_cx_find_handler_for_task(interp, task);
- if (!PMC_IS_NULL(handler)) {
- PMC * const handler_sub = VTABLE_get_attr_str(interp, handler, CONST_STRING(interp, "code"));
- Parrot_pcc_invoke_sub_from_c_args(interp, handler_sub,
- "PP->", handler, task);
- }
- }
- else {
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
- "Unknown task type '%Ss'.\n", type);
- }
-
- Parrot_cx_delete_task(interp, task);
- }
-
- /* If the scheduler was flagged to terminate, make sure you process all
- * tasks. */
- /* if (SCHEDULER_terminate_requested_TEST(scheduler))
- Parrot_cx_refresh_task_list(interp, scheduler); */
-
- } /* end of pending tasks */
-#endif
-
+#define CX_DEBUG 0
/*
@@ -355,6 +315,7 @@
*/
+
PARROT_EXPORT
PARROT_CAN_RETURN_NULL
PMC *
Modified: branches/gsoc_threads/src/interp/inter_create.c
==============================================================================
--- branches/gsoc_threads/src/interp/inter_create.c Tue Aug 3 19:11:36 2010 (r48296)
+++ branches/gsoc_threads/src/interp/inter_create.c Tue Aug 3 21:57:34 2010 (r48297)
@@ -292,7 +292,6 @@
/* all sys running, init the event and signal stuff
* the first or "master" interpreter is handling events and signals
*/
- interp->task_queue = NULL;
interp->thread_data = NULL;
Parrot_cx_init_scheduler(interp);
Modified: branches/gsoc_threads/src/ops/core.ops
==============================================================================
--- branches/gsoc_threads/src/ops/core.ops Tue Aug 3 19:11:36 2010 (r48296)
+++ branches/gsoc_threads/src/ops/core.ops Tue Aug 3 21:57:34 2010 (r48297)
@@ -105,6 +105,10 @@
inline op check_events__() :internal :flow {
opcode_t * const _this = CUR_OPCODE;
+ opcode_t * const handler = Parrot_ex_throw_from_op_args(interp, _this,
+ EXCEPTION_INVALID_OPERATION,
+ "check_events__ opcode doesn't do anything useful.");
+ goto ADDRESS(handler);
/* Restore op_func_table. */
disable_event_checking(interp);
/* Parrot_cx_handle_tasks(interp, interp->scheduler); */
Modified: branches/gsoc_threads/src/ops/core_ops.c
==============================================================================
--- branches/gsoc_threads/src/ops/core_ops.c Tue Aug 3 19:11:36 2010 (r48296)
+++ branches/gsoc_threads/src/ops/core_ops.c Tue Aug 3 21:57:34 2010 (r48297)
@@ -62,6 +62,7 @@
# include <unicode/uchar.h>
#endif
+/* Chandon TODO: Should not have private header here */
#include "parrot/scheduler_private.h"
#include "pmc/pmc_task.h"
@@ -1157,7 +1158,7 @@
Parrot_find_codepoint_i_sc, /* 1080 */
Parrot_finalize_p, /* 1081 */
Parrot_finalize_pc, /* 1082 */
- Parrot_recv_p, /* 1083 */
+ Parrot_receive_p, /* 1083 */
Parrot_wait_p, /* 1084 */
Parrot_wait_pc, /* 1085 */
Parrot_pass, /* 1086 */
@@ -14170,9 +14171,9 @@
},
{ /* 1083 */
/* type PARROT_FUNCTION_OP, */
- "recv",
- "recv_p",
- "Parrot_recv_p",
+ "receive",
+ "receive_p",
+ "Parrot_receive_p",
/* "", body */
0,
2,
@@ -14246,6 +14247,9 @@
Parrot_check_events__(opcode_t *cur_opcode, PARROT_INTERP) {
const Parrot_Context * const CUR_CTX = Parrot_pcc_get_context_struct(interp, interp->ctx);
opcode_t * const _this = CUR_OPCODE;
+ opcode_t * const handler = Parrot_ex_throw_from_op_args(interp, _this,
+ EXCEPTION_INVALID_OPERATION,
+ "check_events__ opcode doesn't do anything useful.");return (opcode_t *)handler;
/* Restore op_func_table. */
disable_event_checking(interp);return (opcode_t *)_this; /* force this being a branch op */
}
@@ -25067,7 +25071,7 @@
return (opcode_t *)cur_opcode + 2;}
opcode_t *
-Parrot_recv_p(opcode_t *cur_opcode, PARROT_INTERP) {
+Parrot_receive_p(opcode_t *cur_opcode, PARROT_INTERP) {
const Parrot_Context * const CUR_CTX = Parrot_pcc_get_context_struct(interp, interp->ctx);
opcode_t *const dest = cur_opcode + 2;
PMC *cur_task = interp->current_task;
@@ -25139,7 +25143,7 @@
PARROT_FUNCTION_CORE, /* core_type = PARROT_XX_CORE */
0, /* flags */
2, /* major_version */
- 5, /* minor_version */
+ 6, /* minor_version */
0, /* patch_version */
1087, /* op_count */
core_op_info_table, /* op_info_table */
Modified: branches/gsoc_threads/src/ops/experimental.ops
==============================================================================
--- branches/gsoc_threads/src/ops/experimental.ops Tue Aug 3 19:11:36 2010 (r48296)
+++ branches/gsoc_threads/src/ops/experimental.ops Tue Aug 3 21:57:34 2010 (r48297)
@@ -9,6 +9,7 @@
# include <unicode/uchar.h>
#endif
+/* Chandon TODO: Should not have private header here */
#include "parrot/scheduler_private.h"
#include "pmc/pmc_task.h"
@@ -417,7 +418,7 @@
}
}
-=item B<recv>(out PMC)
+=item B<receive>(out PMC)
Recieve a message sent to the current task.
@@ -425,7 +426,7 @@
=cut
-op recv(out PMC) {
+op receive(out PMC) {
opcode_t *const dest = expr NEXT();
PMC *cur_task = interp->current_task;
Parrot_Task_attributes *tdata = PARROT_TASK(cur_task);
Modified: branches/gsoc_threads/src/packfile.c
==============================================================================
--- branches/gsoc_threads/src/packfile.c Tue Aug 3 19:11:36 2010 (r48296)
+++ branches/gsoc_threads/src/packfile.c Tue Aug 3 21:57:34 2010 (r48297)
@@ -3159,10 +3159,14 @@
find_constants(PARROT_INTERP, ARGIN(PackFile_ConstTable *ct))
{
ASSERT_ARGS(find_constants)
+
+#ifdef UNUSED_THREAD_CODE
if (!n_interpreters
|| !interp->thread_data
|| interp->thread_data->tid == 0)
+#endif
return ct->constants;
+#ifdef UNUSED_THREAD_CODE
else {
Hash *tables;
PackFile_Constant **new_consts;
@@ -3193,6 +3197,7 @@
return new_consts;
}
+#endif
}
Deleted: branches/gsoc_threads/src/pmc/event.pmc
==============================================================================
--- branches/gsoc_threads/src/pmc/event.pmc Tue Aug 3 21:57:34 2010 (r48296)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,556 +0,0 @@
-/*
-Copyright (C) 2001-2008, Parrot Foundation.
-$Id: task.pmc 48010 2010-07-05 15:36:03Z Chandon $
-
-=head1 NAME
-
-src/pmc/event.pmc - An event that may want to be handled.
-
-=head1 DESCRIPTION
-
-Implements the basic event behavior for the concurrency scheduler.
-
-=head2 Functions
-
-=over 4
-
-=cut
-
-*/
-
-#include "parrot/scheduler_private.h"
-
-/* HEADERIZER HFILE: none */
-/* HEADERIZER BEGIN: static */
-/* HEADERIZER END: static */
-
-pmclass Event provides invokable auto_attrs {
- ATTR INTVAL id; /* The task ID. */
- ATTR INTVAL priority; /* The priority of the task. */
- ATTR FLOATVAL birthtime; /* The creation time stamp of the task. */
- ATTR STRING *type; /* The type of the task. */
- ATTR STRING *subtype; /* The subtype of the task. */
- ATTR STRING *status; /* The status of the task. */
- ATTR Parrot_Interp interp; /* The interpreter that created the task. */
- ATTR PMC *codeblock; /* An (optional) codeblock for the task. */
- ATTR PMC *data; /* Additional data for the task. */
- ATTR char *cb_data; /* Additional data for a callback event. */
-
-/*
-
-=item C<void init()>
-
-Initialize an event object.
-
-=cut
-
-*/
-
- VTABLE void init() {
- Parrot_Event_attributes * const core_struct = PARROT_EVENT(SELF);
-
- /* Set flags for custom GC mark. */
- PObj_custom_mark_SET(SELF);
-
- /* Set up the core struct. */
- core_struct->id = 0;
- core_struct->type = CONST_STRING(INTERP, "");
- core_struct->subtype = CONST_STRING(INTERP, "");
- core_struct->priority = 0;
- core_struct->status = CONST_STRING(INTERP, "created");
- core_struct->birthtime = 0.0;
- core_struct->codeblock = PMCNULL;
- core_struct->data = PMCNULL;
- core_struct->interp = INTERP;
-
- /* Make sure the flag is cleared by default */
- /* TASK_terminate_runloop_CLEAR(SELF); */
-
- }
-
-/*
-
-=item C<void init_pmc(PMC *data)>
-
-Initializes a new Event with a C<Hash> PMC with any or all of the keys:
-
-=over 4
-
-=item C<id>
-
-An C<Integer> representing the task's unique identifier.
-
-=item C<type>
-
-A C<String> representing the type of the task.
-
-=item C<subtype>
-
-A C<String> representing the subtype of the task. (Used mostly by events and
-exceptions to identify appropriate handlers.)
-
-=item C<priority>
-
-An C<Integer> representing the task's priority, from 0 to 100.
-
-=item C<status>
-
-A C<String> representing the task's status, one of C<created>, C<invoked>,
-C<inprocess>, or C<completed>.
-
-=item C<birthtime>
-
-The time at which this Event was inserted into the task list.
-
-=item C<code>
-
-A C<Sub> or descendant PMC related to this task.
-
-=item C<interp>
-
-An interpreter in which to execute this task.
-
-=back
-
-=cut
-
-*/
-
- VTABLE void init_pmc(PMC *data) {
- PMC *elem;
- Parrot_Event_attributes *core_struct;
-
- if (! VTABLE_isa(INTERP, data, CONST_STRING(INTERP, "Hash")))
- Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
- "Event initializer must be a Hash");
-
- core_struct = (Parrot_Event_attributes *) PMC_data(SELF);
-
- /* Set flags for custom GC mark. */
- PObj_custom_mark_SET(SELF);
-
- /* Set up the core struct. */
-
- elem = VTABLE_get_pmc_keyed_str(INTERP, data, CONST_STRING(INTERP, "id"));
- if (! PMC_IS_NULL(elem))
- core_struct->id = VTABLE_get_integer(INTERP, elem);
- else
- core_struct->id = 0;
-
- elem = VTABLE_get_pmc_keyed_str(INTERP, data, CONST_STRING(INTERP, "type"));
- if (! PMC_IS_NULL(elem))
- core_struct->type = VTABLE_get_string(INTERP, elem);
- else
- core_struct->type = CONST_STRING(INTERP, "");
-
- elem = VTABLE_get_pmc_keyed_str(INTERP, data, CONST_STRING(INTERP, "subtype"));
- if (! PMC_IS_NULL(elem))
- core_struct->subtype = VTABLE_get_string(INTERP, elem);
- else
- core_struct->subtype = CONST_STRING(INTERP, "");
-
- elem = VTABLE_get_pmc_keyed_str(INTERP, data, CONST_STRING(INTERP, "priority"));
- if (! PMC_IS_NULL(elem))
- core_struct->priority = VTABLE_get_integer(INTERP, elem);
- else
- core_struct->priority = 0;
-
- elem = VTABLE_get_pmc_keyed_str(INTERP, data, CONST_STRING(INTERP, "status"));
- if (! PMC_IS_NULL(elem))
- core_struct->status = VTABLE_get_string(INTERP, elem);
- else
- core_struct->status = CONST_STRING(INTERP, "created");
-
- elem = VTABLE_get_pmc_keyed_str(INTERP, data, CONST_STRING(INTERP, "birthtime"));
- if (! PMC_IS_NULL(elem))
- core_struct->birthtime = VTABLE_get_number(INTERP, elem);
- else
- core_struct->birthtime = 0.0;
-
- core_struct->codeblock = VTABLE_get_pmc_keyed_str(INTERP, data, CONST_STRING(INTERP, "code"));
- core_struct->interp = (Parrot_Interp)VTABLE_get_pmc_keyed_str(INTERP, data, CONST_STRING(INTERP, "data"));
- }
-
-/*
-
-=item C<opcode_t *invoke(void *next)>
-
-Invokes whatever is in the Event's associated codeblock.
-
-If the Event's data attribute is not null, pass it to the
-codeblock as the first argument.
-
-=cut
-
-*/
-
- VTABLE opcode_t *invoke(void *next) {
- Parrot_Event_attributes *const task = PARROT_EVENT(SELF);
-
- if (PMC_IS_NULL(task->codeblock))
- return (opcode_t*) next;
-
- if (PMC_IS_NULL(task->data)) {
- Parrot_pcc_invoke_sub_from_c_args(interp, task->codeblock, "->");
- }
- else {
- Parrot_pcc_invoke_sub_from_c_args(interp, task->codeblock, "P->", task->data);
- }
-
- return (opcode_t*) next;
- }
-
-
-/*
-
-=item C<PMC *clone()>
-
-Create a copy of the task, resetting status, ID, and birthtime.
-
-=cut
-
-*/
-
- VTABLE PMC *clone() {
- /* Create the new task PMC, of the same type of this one (we may
- * have been subclassed). */
- PMC * const copy = Parrot_pmc_new(INTERP, SELF->vtable->base_type);
- Parrot_Event_attributes * const new_struct = PARROT_EVENT(copy);
- Parrot_Event_attributes * const old_struct = PARROT_EVENT(SELF);
-
- new_struct->codeblock = VTABLE_clone(INTERP, old_struct->codeblock);
- new_struct->data = old_struct->data;
- new_struct->type = old_struct->type;
- new_struct->subtype = old_struct->subtype;
- new_struct->priority = old_struct->priority;
-
- return copy;
- }
-/*
-
-=item C<PMC *get_attr_str(STRING *name)>
-
-Gets the value of an attribute for this task.
-
-=cut
-
-*/
- VTABLE PMC *get_attr_str(STRING *name) {
- Parrot_Event_attributes * const core_struct = PARROT_EVENT(SELF);
- PMC *value;
-
- if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "id"))) {
- value = Parrot_pmc_new_init_int(INTERP, enum_class_Integer,
- core_struct->id);
- }
- else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "type"))) {
- value = Parrot_pmc_new(INTERP, enum_class_String);
- VTABLE_set_string_native(INTERP, value, core_struct->type);
- }
- else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "subtype"))) {
- value = Parrot_pmc_new(INTERP, enum_class_String);
- VTABLE_set_string_native(INTERP, value, core_struct->subtype);
- }
- else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "priority"))) {
- value = Parrot_pmc_new_init_int(INTERP, enum_class_Integer,
- core_struct->priority);
- }
- else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "status"))) {
- value = Parrot_pmc_new(INTERP, enum_class_String);
- VTABLE_set_string_native(INTERP, value, core_struct->status);
- }
- else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "birthtime"))) {
- value = Parrot_pmc_new(INTERP, enum_class_Float);
- VTABLE_set_number_native(INTERP, value, core_struct->birthtime);
- }
- else {
- value = PMCNULL;
- }
-
- return value;
- }
-
-/*
-
-=item C<void set_attr_str(STRING *name, PMC *value)>
-
-Sets the value of an attribute for this task.
-
-=cut
-
-*/
- VTABLE void set_attr_str(STRING *name, PMC *value) {
- Parrot_Event_attributes * const core_struct = PARROT_EVENT(SELF);
-
- if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "id"))) {
- core_struct->id = VTABLE_get_integer(INTERP, value);
- }
- else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "type"))) {
- core_struct->type = VTABLE_get_string(INTERP, value);
- }
- else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "subtype"))) {
- core_struct->subtype = VTABLE_get_string(INTERP, value);
- }
- else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "priority"))) {
- core_struct->priority = VTABLE_get_integer(INTERP, value);
- }
- else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "status"))) {
- core_struct->status = VTABLE_get_string(INTERP, value);
- }
- else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "birthtime"))) {
- core_struct->birthtime = VTABLE_get_number(INTERP, value);
- }
- else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "code"))) {
- core_struct->codeblock = value;
- }
- else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "data"))) {
- core_struct->data = value;
- }
- }
-
-/*
-
-=item C<INTVAL get_integer()>
-
-Retrieves the task ID for this task.
-
-=cut
-
-*/
- VTABLE INTVAL get_integer() {
- Parrot_Event_attributes * const core_struct = PARROT_EVENT(SELF);
- return core_struct->id;
- }
-
-/*
-
-=item C<void set_integer_native(INTVAL value)>
-
-Sets the task ID of the task.
-
-=cut
-
-*/
-
- VTABLE void set_integer_native(INTVAL value) {
- Parrot_Event_attributes * const core_struct = PARROT_EVENT(SELF);
- core_struct->id = value;
- }
-
-/*
-
-=item C<void set_number_native(FLOATVAL value)>
-
-Sets the birthtime of the task.
-
-=cut
-
-*/
-
- VTABLE void set_number_native(FLOATVAL value) {
- Parrot_Event_attributes * const core_struct = PARROT_EVENT(SELF);
- core_struct->birthtime = value;
- }
-
-/*
-
-=item C<void set_string_native(STRING *value)>
-
-Sets the type of the task.
-
-=cut
-
-*/
-
- VTABLE void set_string_native(STRING *value) {
- Parrot_Event_attributes * const core_struct = PARROT_EVENT(SELF);
- core_struct->type = value;
- }
-
-/*
-
-=item C<PMC *share_ro()>
-
-Set this PMC as shared.
-
-=cut
-
-*/
-
- VTABLE PMC *share_ro() {
- PMC *shared_self;
- Parrot_Event_attributes *shared_struct;
-
- if (PObj_is_PMC_shared_TEST(SELF))
- return SELF;
-
- shared_self = pt_shared_fixup(INTERP, SELF);
- shared_struct = PARROT_EVENT(shared_self);
-
- if (!PMC_IS_NULL(shared_struct->codeblock))
- shared_struct->codeblock = pt_shared_fixup(INTERP, shared_struct->codeblock);
-
- if (!PMC_IS_NULL(shared_struct->data))
- shared_struct->data = pt_shared_fixup(INTERP, shared_struct->data);
-
- return shared_self;
- }
-
-/*
-
-=item C<void mark()>
-
-Mark any referenced strings and PMCs.
-
-=cut
-
-*/
- VTABLE void mark() {
- if (PARROT_EVENT(SELF)) {
- Parrot_Event_attributes * const core_struct = PARROT_EVENT(SELF);
-
- Parrot_gc_mark_STRING_alive(INTERP, core_struct->type);
- Parrot_gc_mark_STRING_alive(INTERP, core_struct->subtype);
- Parrot_gc_mark_STRING_alive(INTERP, core_struct->status);
- Parrot_gc_mark_PMC_alive(INTERP, core_struct->codeblock);
- Parrot_gc_mark_PMC_alive(INTERP, core_struct->data);
- }
- }
-
-/*
-
-=item C<void visit(PMC *info)>
-
-This is used by freeze/thaw to visit the contents of the task.
-
-C<*info> is the visit info, (see F<include/parrot/pmc_freeze.h>).
-
-=cut
-
-*/
-
- VTABLE void visit(PMC *info) {
- /* 1) visit code block */
- VISIT_PMC_ATTR(INTERP, info, SELF, Event, codeblock);
- }
-
-/*
-
-=item C<void freeze(PMC *info)>
-
-Used to archive the task.
-
-=cut
-
-*/
-
- VTABLE void freeze(PMC *info) {
- const Parrot_Event_attributes * const core_struct = PARROT_EVENT(SELF);
-
- /* 1) freeze task id */
- VTABLE_push_integer(INTERP, info, core_struct->id);
-
- /* 2) freeze task birthtime */
- VTABLE_push_float(INTERP, info, core_struct->birthtime);
-
- /* 3) freeze task priority */
- VTABLE_push_integer(INTERP, info, core_struct->priority);
-
- /* 4) freeze task type */
- VTABLE_push_string(INTERP, info, core_struct->type);
-
- /* 5) freeze task subtype */
- VTABLE_push_string(INTERP, info, core_struct->subtype);
-
- /* 6) freeze task status */
- VTABLE_push_string(INTERP, info, core_struct->status);
- }
-
-/*
-
-=item C<void thaw(PMC *info)>
-
-Used to unarchive the task.
-
-=cut
-
-*/
-
- VTABLE void thaw(PMC *info) {
- /* 1. thaw task id */
- const INTVAL id = VTABLE_shift_integer(INTERP, info);
-
- /* 2. thaw task birthtime */
- const FLOATVAL birthtime = VTABLE_shift_float(INTERP, info);
-
- /* 3. thaw task priority */
- const INTVAL priority = VTABLE_shift_integer(INTERP, info);
-
- /* 4. thaw task type */
- STRING * const type = VTABLE_shift_string(INTERP, info);
-
- /* 5. thaw task subtype */
- STRING * const subtype = VTABLE_shift_string(INTERP, info);
-
- /* 6. thaw task status */
- STRING * const status = VTABLE_shift_string(INTERP, info);
-
- /* Allocate the task's core data struct and set custom flags. */
- SELF.init();
-
- /* Set the task's id to the frozen id */
- PARROT_EVENT(SELF)->id = id;
-
- /* Set the task's birthtime to the frozen birthtime */
- PARROT_EVENT(SELF)->birthtime = birthtime;
-
- /* Set the task's type to the frozen type */
- PARROT_EVENT(SELF)->type = type;
-
- /* Set the task's subtype to the frozen subtype */
- PARROT_EVENT(SELF)->subtype = subtype;
-
- /* Set the task's priority to the frozen priority */
- PARROT_EVENT(SELF)->priority = priority;
-
- /* Set the task's status to the frozen status */
- PARROT_EVENT(SELF)->status = status;
-
- }
-
-/*
-
-=item C<void thawfinish(PMC *info)>
-
-Called after the task has been thawed.
-
-=cut
-
-*/
-
- VTABLE void thawfinish(PMC *info) {
- Parrot_Event_attributes * core_struct = PARROT_EVENT(SELF);
-
- UNUSED(core_struct); /* TODO: Rebuild the task index. */
- }
-
-}
-
-/*
-
-=back
-
-=head1 SEE ALSO
-
-F<docs/pdds/pdd15_objects.pod>.
-
-=cut
-
-*/
-
-/*
- * Local variables:
- * c-file-style: "parrot"
- * End:
- * vim: expandtab shiftwidth=4:
- */
Modified: branches/gsoc_threads/src/pmc/parrotinterpreter.pmc
==============================================================================
--- branches/gsoc_threads/src/pmc/parrotinterpreter.pmc Tue Aug 3 19:11:36 2010 (r48296)
+++ branches/gsoc_threads/src/pmc/parrotinterpreter.pmc Tue Aug 3 21:57:34 2010 (r48297)
@@ -177,9 +177,6 @@
Interp_flags flag = PARROT_NO_FLAGS;
Parrot_Interp new_interp;
- if (self->vtable->base_type == enum_class_ParrotThread)
- flag = PARROT_IS_THREAD;
-
new_interp = make_interpreter(parent, (INTVAL)flag);
PMC_interp(self) = new_interp;
@@ -666,15 +663,6 @@
return 0;
}
- MULTI INTVAL is_equal(ParrotThread value) {
- Parrot_Interp self = PMC_interp(SELF);
-
- if (!self->thread_data)
- return 0;
-
- return self->thread_data->tid == (UINTVAL) VTABLE_get_integer(INTERP, value);
- }
-
MULTI INTVAL is_equal(DEFAULT value) {
Parrot_ex_throw_from_c_args(INTERP, NULL,
EXCEPTION_INTERNAL_NOT_IMPLEMENTED,
Deleted: branches/gsoc_threads/src/pmc/parrotthread.pmc
==============================================================================
--- branches/gsoc_threads/src/pmc/parrotthread.pmc Tue Aug 3 21:57:34 2010 (r48296)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,181 +0,0 @@
-/*
-Copyright (C) 2001-2010, Parrot Foundation.
-$Id$
-
-=head1 NAME
-
-src/pmc/parrotthread.pmc - Represents a Parrot Thread.
-
-=head1 DESCRIPTION
-
-This type represents a parrot thread.
-
-It provides the following methods:
- - join
- - detach
- - kill
- - pid
-
-=head2 Methods
-
-=over 4
-
-=cut
-
-*/
-
-#include "parrot/embed.h"
-
-
-pmclass ParrotThread no_ro auto_attrs {
- ATTR INTVAL tid; /* thread id */
-
-/* HEADERIZER HFILE: none */
-/* HEADERIZER BEGIN: static */
-/* HEADERIZER END: static */
-
-/*
-
-=item C<void init()>
-
-Create a new, invalid handle to a running thread.
-
-=cut
-
-*/
-
- VTABLE void init() {
- VTABLE_set_integer_native(INTERP, SELF, -1);
- }
-
-/*
-
-=item C<void init_pmc(PMC *notused)>
-
-Create a new, invalid handle to a running thread.
-
-=cut
-
-*/
-
- VTABLE void init_pmc(PMC *notused) {
- VTABLE_set_integer_native(INTERP, SELF, -1);
- }
-
-/*
-
-=item C<INTVAL get_integer()>
-
-Return the thread ID of this thread.
-
-=cut
-
-*/
-
- VTABLE INTVAL get_integer() {
- INTVAL ttid;
- GETATTR_ParrotThread_tid(INTERP, SELF, ttid);
- return ttid;
- }
-
- VTABLE void set_integer_native(INTVAL ttid) {
- SETATTR_ParrotThread_tid(INTERP, SELF, ttid);
- }
-
-
-/*
-
-=item C<METHOD run(closure)>
-
-Join the thread, returning whatever its main method returns.
-
-=cut
-
-*/
- METHOD run_clone(PMC *sub, PMC *args :slurpy) {
- INTVAL ttid;
- if (PMC_IS_NULL(sub)) {
- Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
- "Invalid thread sub");
- }
-
- ttid = pt_thread_create_run(INTERP,
- enum_class_ThreadInterpreter, PARROT_CLONE_DEFAULT, sub, args);
- VTABLE_set_integer_native(INTERP, SELF, ttid);
- }
-
- METHOD run(INTVAL clone_flags, PMC *sub, PMC *args :slurpy) {
- INTVAL ttid;
- if (PMC_IS_NULL(sub)) {
- Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
- "Invalid thread sub");
- }
-
- ttid = pt_thread_create_run(INTERP, enum_class_ThreadInterpreter, clone_flags, sub, args);
- VTABLE_set_integer_native(INTERP, SELF, ttid);
- }
-/*
-
-=item C<METHOD join()>
-
-Join the thread, returning whatever its main method returns.
-
-=cut
-
-*/
- METHOD join() {
- PMC *ret;
- INTVAL ttid = VTABLE_get_integer(INTERP, SELF);
-
- ret = pt_thread_join(INTERP, ttid);
- /* invalidate self */
- VTABLE_set_integer_native(INTERP, SELF, -1);
-
- RETURN(PMC *ret);
- }
-
-/*
-
-=item C<METHOD detach()>
-
-Detach the thread so it cannot be joined and will free its resources
-immediately when it exits.
-
-=cut
-
-*/
-
- METHOD detach() {
- pt_thread_detach((UINTVAL)VTABLE_get_integer(INTERP, SELF));
- }
-
-/*
-
-=item C<METHOD kill()>
-
-Terminate a running thread.
-
-=cut
-
-*/
-
- METHOD kill() {
- pt_thread_kill((UINTVAL)VTABLE_get_integer(INTERP, SELF));
- }
-
-}
-
-/*
-
-=back
-
-=cut
-
-*/
-
-/*
- * Local variables:
- * c-file-style: "parrot"
- * End:
- * vim: expandtab shiftwidth=4:
- */
Modified: branches/gsoc_threads/src/pmc/pmclist.pmc
==============================================================================
--- branches/gsoc_threads/src/pmc/pmclist.pmc Tue Aug 3 19:11:36 2010 (r48296)
+++ branches/gsoc_threads/src/pmc/pmclist.pmc Tue Aug 3 21:57:34 2010 (r48297)
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2001-2010, Parrot Foundation.
+Copyright (C) 2010, Parrot Foundation.
$Id$
=head1 NAME
@@ -555,7 +555,7 @@
{
ASSERT_ARGS(throw_shift_empty)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_OUT_OF_BOUNDS,
- "PMCList: Can't shift from an empty array!");
+ "PMCList: Can't shift from an empty list!");
}
PARROT_DOES_NOT_RETURN
@@ -564,7 +564,7 @@
{
ASSERT_ARGS(throw_pop_empty)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_OUT_OF_BOUNDS,
- "PMCList: Can't pop from an empty array!");
+ "PMCList: Can't pop from an empty list!");
}
/*
Added: branches/gsoc_threads/src/pmc/poolthread.pmc
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/gsoc_threads/src/pmc/poolthread.pmc Tue Aug 3 21:57:34 2010 (r48297)
@@ -0,0 +1,87 @@
+/*
+Copyright (C) 2010, Parrot Foundation.
+$Id$
+
+=head1 NAME
+
+src/pmc/poolthread.pmc - Represents a native thread for an interpreter thread pool.
+
+=head1 DESCRIPTION
+
+This OS thread will hang out in the interpreter thread pool, mostly blocked on a
+per-interpreter mutex or - if it's lucky - on IO.
+
+=head2 Methods
+
+=over 4
+
+=cut
+*/
+
+#include "parrot/parrot.h"
+#include "parrot/thread.h"
+
+void* Parrot_PoolThread_main(void* arg);
+
+typedef struct Parrot_PoolThread_args {
+ PMC *pool_thread;
+ Interp *interp;
+} Parrot_PoolThread_args;
+
+pmclass PoolThread auto_attrs {
+ ATTR Parrot_thread thread;
+ ATTR void *args;
+
+ /*
+ =item C<void init()>
+
+ Create a new OS thread.
+
+ =cut
+ */
+
+ VTABLE void init() {
+ Parrot_PoolThread_attributes *tdata = PARROT_POOLTHREAD(SELF);
+ Parrot_PoolThread_args *args =
+ (Parrot_PoolThread_args*) malloc(sizeof(Parrot_PoolThread_args));
+
+ PObj_custom_destroy_SET(SELF);
+
+ tdata->args = (void*) args;
+ THREAD_CREATE_JOINABLE(tdata->thread, Parrot_PoolThread_main, tdata->args);
+ }
+
+ VTABLE void destroy() {
+ Parrot_PoolThread_attributes *tdata = PARROT_POOLTHREAD(SELF);
+ free(tdata->args);
+ }
+}
+
+void*
+Parrot_PoolThread_main(void* args_ptr)
+{
+ Parrot_PoolThread_args *args = (Parrot_PoolThread_args*) args_ptr;
+ Interp* interp = args->interp;
+
+ LOCK(interp->interp_lock);
+
+
+ UNLOCK(interp->interp_lock);
+
+ return 0;
+}
+
+/*
+
+=back
+
+=cut
+
+*/
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
Modified: branches/gsoc_threads/src/pmc/scheduler.pmc
==============================================================================
--- branches/gsoc_threads/src/pmc/scheduler.pmc Tue Aug 3 19:11:36 2010 (r48296)
+++ branches/gsoc_threads/src/pmc/scheduler.pmc Tue Aug 3 21:57:34 2010 (r48297)
@@ -125,32 +125,6 @@
PMC *const type_pmc = VTABLE_get_attr_str(interp, task, CONST_STRING(interp, "type"));
STRING *const type = VTABLE_get_string(interp, type_pmc);
-
-#ifdef COMPILE_OLD_SCHEDULER_CODE
- Parrot_Scheduler_attributes * const core_struct = PARROT_SCHEDULER(SELF);
- STRING *task_id_str;
- INTVAL new_tid;
-
- task = VTABLE_share_ro(INTERP, task);
- VTABLE_set_number_native(INTERP, task, Parrot_floatval_time());
-
- new_tid = ++(core_struct->max_tid);
- VTABLE_set_integer_native(INTERP, task, new_tid);
- task_id_str = Parrot_str_from_int(INTERP, new_tid);
-
- VTABLE_set_pmc_keyed_str(INTERP, core_struct->task_list,
- task_id_str, task);
-
- if (task->vtable->base_type == enum_class_Timer)
- VTABLE_push_integer(INTERP, core_struct->wait_index, new_tid);
- else
- VTABLE_push_integer(INTERP, core_struct->task_index, new_tid);
-
- SCHEDULER_cache_valid_CLEAR(SELF);
-
- if (task->vtable->base_type != enum_class_Exception)
- Parrot_cx_runloop_wake(core_struct->INTERP, SELF);
-#endif
}
@@ -377,161 +351,6 @@
RETURN(PMC* tasks);
}
-
-/*
-
-=item C<METHOD add_handler(PMC *handler)>
-
-Adds a handler to the scheduler.
-
-=cut
-
-*/
-
- METHOD add_handler(PMC *handler) {
- Parrot_Scheduler_attributes *core_struct = PARROT_SCHEDULER(SELF);
- VTABLE_unshift_pmc(INTERP, core_struct->handlers, handler);
- }
-
-
-/*
-
-=item C<METHOD delete_handler(STRING *type :optional, INTVAL have_type :opt_flag)>
-
-Deletes a handler from the scheduler.
-
-=cut
-
-*/
-
- METHOD delete_handler(STRING *type :optional, INTVAL have_type :opt_flag) {
- PMC *handlers;
- INTVAL elements, index;
- STRING * const except_str = CONST_STRING(INTERP, "exception");
- STRING * const event_str = CONST_STRING(INTERP, "event");
-
- GET_ATTR_handlers(INTERP, SELF, handlers);
- elements = VTABLE_elements(INTERP, handlers);
-
- if (!have_type)
- VTABLE_shift_pmc(INTERP, handlers);
-
- /* Loop from newest handler to oldest handler. */
- for (index = 0; index < elements; ++index) {
- const PMC * const handler = VTABLE_get_pmc_keyed_int(INTERP, handlers, index);
- if (!PMC_IS_NULL(handler)) {
- if (Parrot_str_equal(INTERP, type, except_str)
- && handler->vtable->base_type == enum_class_ExceptionHandler) {
- VTABLE_set_pmc_keyed_int(INTERP, handlers, index, PMCNULL);
- RETURN(void);
- }
- else if (Parrot_str_equal(INTERP, type, event_str)
- && handler->vtable->base_type == enum_class_EventHandler) {
- VTABLE_set_pmc_keyed_int(INTERP, handlers, index, PMCNULL);
- RETURN(void);
- }
- }
- }
-
- Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
- "No handler to delete.");
- }
-
-
-/*
-
-=item C<METHOD find_handler(PMC *task)>
-
-Searchs for a handler for the given task. If no handler is found, returns
-PMCNULL.
-
-=cut
-
-*/
-
- METHOD find_handler(PMC *task) {
- STRING * const handled_str = CONST_STRING(INTERP, "handled");
- STRING * const iter_str = CONST_STRING(INTERP, "handler_iter");
- PMC *iter;
-
- fprintf(stderr, "Derf\n");
-
- /* Exceptions store the handler iterator for rethrow, other kinds of
- * tasks don't (though they could). */
- if (task->vtable->base_type == enum_class_Exception
- && VTABLE_get_integer_keyed_str(INTERP, task, handled_str) == -1) {
- iter = VTABLE_get_attr_str(INTERP, task, iter_str);
- }
- else {
- PMC *handlers;
- GET_ATTR_handlers(INTERP, SELF, handlers);
- iter = VTABLE_get_iter(INTERP, handlers);
-
- if (task->vtable->base_type == enum_class_Exception)
- VTABLE_set_attr_str(INTERP, task, iter_str, iter);
- }
-
- /* Loop from newest handler to oldest handler. */
- while (VTABLE_get_bool(INTERP, iter)) {
- PMC * const handler = VTABLE_shift_pmc(INTERP, iter);
-
- INTVAL valid_handler = 0;
- if (!PMC_IS_NULL(handler)) {
- (const INTVAL valid_handler) = PCCINVOKE(INTERP, handler, "can_handle", PMC *task);
- if (valid_handler) {
- if (task->vtable->base_type == enum_class_Exception)
- VTABLE_set_integer_native(INTERP, handler, 1);
- RETURN(PMC *handler);
- }
- }
-
- }
-
- RETURN(PMC *PMCNULL);
- }
-
-
-/*
-
-=item C<METHOD count_handlers(STRING *type :optional, INTVAL have_type :opt_flag)>
-
-Returns the number of handlers currently held by the scheduler. If a type
-argument is passed, only counts handlers of that type (C<event>, C<exception>).
-If no type argument is passed, counts all handlers.
-
-=cut
-
-*/
-
- METHOD count_handlers(STRING *type :optional, INTVAL have_type :opt_flag) {
- /* avoid uninitialized value warning */
- PMC *handlers = NULL;
- INTVAL elements;
- INTVAL count = 0;
- INTVAL index;
-
- GET_ATTR_handlers(INTERP, SELF, handlers);
- elements = VTABLE_elements(INTERP, handlers);
-
- if (!have_type)
- RETURN(INTVAL elements);
-
- for (index = 0; index < elements; ++index) {
- const PMC * const handler = VTABLE_get_pmc_keyed_int(INTERP, handlers, index);
- STRING * const exception = CONST_STRING(INTERP, "exception");
- STRING * const event = CONST_STRING(INTERP, "event");
-
- if (!PMC_IS_NULL(handler)) {
- if ((Parrot_str_equal(INTERP, type, exception)
- && handler->vtable->base_type == enum_class_ExceptionHandler)
- || (Parrot_str_equal(INTERP, type, event)
- && handler->vtable->base_type == enum_class_EventHandler))
- ++count;
- }
- }
-
- RETURN(INTVAL count);
- }
}
/*
Modified: branches/gsoc_threads/t/native_pbc/annotations.pbc
==============================================================================
Binary file (source and/or target). No diff available.
Modified: branches/gsoc_threads/t/native_pbc/integer.pbc
==============================================================================
Binary file (source and/or target). No diff available.
Modified: branches/gsoc_threads/t/native_pbc/number.pbc
==============================================================================
Binary file (source and/or target). No diff available.
Modified: branches/gsoc_threads/t/native_pbc/string.pbc
==============================================================================
Binary file (source and/or target). No diff available.
Deleted: branches/gsoc_threads/t/pmc/event.t
==============================================================================
--- branches/gsoc_threads/t/pmc/event.t Tue Aug 3 21:57:34 2010 (r48296)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,194 +0,0 @@
-#! perl
-# Copyright (C) 2007, Parrot Foundation.
-# $Id$
-
-use strict;
-use warnings;
-use lib qw( . lib ../lib ../../lib );
-use Test::More;
-use Parrot::Test tests => 3;
-
-=head1 NAME
-
-t/pmc/event.t - Concurrent Event
-
-=head1 SYNOPSIS
-
- % prove t/pmc/event.t
-
-=head1 DESCRIPTION
-
-Tests the event PMC used by the concurrency scheduler.
-
-=cut
-
-pir_output_is( <<'CODE', <<'OUT', "create an event and set attributes" );
- .sub main :main
- $P0 = new ['Event']
- $P1 = getattribute $P0, 'status'
- print $P1
- print "\n"
-
- $P2 = new ['String']
- $P2 = "inprocess"
- setattribute $P0, 'status', $P2
-
- $P3 = getattribute $P0, 'status'
- print $P3
- print "\n"
-
- $P2 = new ['String']
- $P2 = "event"
- setattribute $P0, 'type', $P2
-
- $P3 = getattribute $P0, 'type'
- print $P3
- print "\n"
-
- $P2 = new ['Integer']
- $P2 = 10
- setattribute $P0, 'priority', $P2
-
- $P3 = getattribute $P0, 'priority'
- print $P3
- print "\n"
-
- $P2 = new ['Integer']
- $P2 = 7405
- setattribute $P0, 'id', $P2
-
- $P3 = getattribute $P0, 'id'
- print $P3
- print "\n"
-
- $P2 = new ['Float']
- $P2 = 1.1
- setattribute $P0, 'birthtime', $P2
-
- $P3 = getattribute $P0, 'birthtime'
- print $P3
- print "\n"
- end
- .end
-CODE
-created
-inprocess
-event
-10
-7405
-1.1
-OUT
-
-pir_output_is( <<'CODE', <<'OUT', 'create an event and set attributes in init' );
- .sub main :main
- .local pmc data
- data = new ['Hash']
-
- $P2 = new ['String']
- $P2 = 'inprocess'
- data['status'] = $P2
-
- $P2 = new ['String']
- $P2 = 'event'
- data['type'] = $P2
-
- $P2 = new ['Integer']
- $P2 = 10
- data['priority'] = $P2
-
- $P2 = new ['Integer']
- $P2 = 7405
- data['id'] = $P2
-
- $P2 = new ['Float']
- $P2 = 1.1
- data['birthtime'] = $P2
-
- $P0 = new ['Event'], data
-
- $P3 = getattribute $P0, 'status'
- say $P3
-
- $P3 = getattribute $P0, 'type'
- say $P3
-
- $P3 = getattribute $P0, 'priority'
- say $P3
-
- $P3 = getattribute $P0, 'id'
- say $P3
-
- $P3 = getattribute $P0, 'birthtime'
- say $P3
- end
- .end
-CODE
-inprocess
-event
-10
-7405
-1.1
-OUT
-
-pir_output_is( <<'CODE', <<'OUT', "freeze and thaw an event" );
- .sub main :main
- $P0 = new ['Event']
-
- $P2 = new ['String']
- $P2 = "inprocess"
- setattribute $P0, 'status', $P2
-
- $P2 = new ['String']
- $P2 = "event"
- setattribute $P0, 'type', $P2
-
- $P2 = new ['Integer']
- $P2 = 10
- setattribute $P0, 'priority', $P2
-
- $P2 = new ['Integer']
- $P2 = 7405
- setattribute $P0, 'id', $P2
-
- $P2 = new ['Float']
- $P2 = 1.1
- setattribute $P0, 'birthtime', $P2
-
- $S0 = freeze $P0
- $P10 = thaw $S0
-
- $P3 = getattribute $P10, 'status'
- print $P3
- print "\n"
-
- $P3 = getattribute $P10, 'type'
- print $P3
- print "\n"
-
- $P3 = getattribute $P10, 'priority'
- print $P3
- print "\n"
-
- $P3 = getattribute $P10, 'id'
- print $P3
- print "\n"
-
- $P3 = getattribute $P10, 'birthtime'
- print $P3
- print "\n"
- end
- .end
-CODE
-inprocess
-event
-10
-7405
-1.1
-OUT
-
-# Local Variables:
-# mode: cperl
-# cperl-indent-level: 4
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4:
Deleted: branches/gsoc_threads/t/pmc/parrotthread.t
==============================================================================
--- branches/gsoc_threads/t/pmc/parrotthread.t Tue Aug 3 21:57:34 2010 (r48296)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,33 +0,0 @@
-#!./parrot
-# Copyright (C) 2006-2008, Parrot Foundation.
-# $Id$
-
-=head1 NAME
-
-t/pmc/parrotthread.t - test the ParrotThread PMC
-
-=head1 SYNOPSIS
-
- % prove t/pmc/parrotthread.t
-
-=head1 DESCRIPTION
-
-Tests the ParrotThread PMC.
-
-=cut
-
-.sub 'main' :main
- .include 'test_more.pir'
-
- plan(1)
-
- new $P0, ['ParrotThread']
- ok(1, 'Instantiated a ParrotThread PMC')
-
-.end
-
-# Local Variables:
-# mode: pir
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4 ft=pir:
Deleted: branches/gsoc_threads/t/pmc/scheduler.t
==============================================================================
--- branches/gsoc_threads/t/pmc/scheduler.t Tue Aug 3 21:57:34 2010 (r48296)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,123 +0,0 @@
-#!./parrot
-# Copyright (C) 2007-2010, Parrot Foundation.
-# $Id$
-
-=head1 NAME
-
-t/pmc/scheduler.t - Concurrency Scheduler
-
-=head1 SYNOPSIS
-
- % prove t/pmc/scheduler.t
-
-=head1 DESCRIPTION
-
-Tests the concurrency scheduler PMC.
-
-=cut
-
-
-.sub main :main
- .include 'test_more.pir'
- plan(1)
- skip("Chandon TODO: Rewrite scheduler tests.")
- exit 0
-
- create_and_set_attributes()
- create_concurrent_scheduler_with_init()
- add_event_and_handler_to_scheduler()
-.end
-
-.sub create_and_set_attributes
- $P0 = new ['Scheduler']
- $P1 = new ['Task']
-
- push $P0, $P1
-
- $P2 = pop $P0
-
- if null $P2 goto no_task
- $P3 = getattribute $P2, 'status'
- $S0 = $P3
- is($S0, "created", "got task")
- goto got_task
-
-no_task:
- ok(0,"no task to retrieve")
-
-got_task:
-
- ok(1, "didn't explode")
-.end
-
-.sub create_concurrent_scheduler_with_init
- .local pmc data
- data = new ['Hash']
-
- .local pmc id
- id = new ['Integer']
- id = 128
- data['id'] = id
-
- $P0 = new ['Scheduler'], data
- $P1 = new ['Task']
-
- push $P0, $P1
-
- $P2 = pop $P0
-
- if null $P2 goto no_task
- $P3 = getattribute $P2, 'status'
- $S0 = $P3
- is($S0, "created", "status is ok")
- goto got_task
-
-no_task:
- ok(0, 'no task to retrieve')
-
-got_task:
- ok(1, "got a task")
-
- push_eh bad_initializer
- $P0 = new ['Scheduler'], id
- pop_eh
-
- ok(0, "No exception on invalid initializer? Uh oh!")
- end
-
-bad_initializer:
- ok(1, "Caught exception on bad initializer")
-.end
-
-
-.sub add_event_and_handler_to_scheduler
- .local pmc handler, handler_init, handler_sub
- .local pmc event, event_init
- handler_init = new ['Hash']
- handler_init['type'] = 'myevent'
- handler_sub = get_global 'my_event_handler'
- handler_init['code'] = handler_sub
- handler = new ['EventHandler'], handler_init
-
- addhandler handler
-
- event_init = new ['Hash']
- event_init['type'] = 'event'
- event_init['subtype'] = 'myevent'
- event = new ['Task'], event_init
-
- schedule event
-
-.end
-
-.sub my_event_handler
- .param pmc handler
- .param pmc handledtask
- ok(1, "called event handler")
-.end
-
-# Local Variables:
-# mode: pir
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4 ft=pir:
Modified: branches/gsoc_threads/t/pmc/task.t
==============================================================================
--- branches/gsoc_threads/t/pmc/task.t Tue Aug 3 19:11:36 2010 (r48296)
+++ branches/gsoc_threads/t/pmc/task.t Tue Aug 3 21:57:34 2010 (r48297)
@@ -82,14 +82,14 @@
.end
.sub recv_msg1
- $P0 = recv
+ $P0 = receive
$P1 = new 'String'
$P1 = "Hai 1"
is($P0, $P1, "Got message after block")
.end
.sub recv_msg2
- $P0 = recv
+ $P0 = receive
$P1 = new 'String'
$P1 = "Hai 2"
is($P0, $P1, "Got existing message")
Modified: branches/gsoc_threads/t/pmc/task_primes.t
==============================================================================
--- branches/gsoc_threads/t/pmc/task_primes.t Tue Aug 3 19:11:36 2010 (r48296)
+++ branches/gsoc_threads/t/pmc/task_primes.t Tue Aug 3 21:57:34 2010 (r48297)
@@ -31,23 +31,40 @@
$I0 = $I0 + 1
if $I0 < 100 goto loop
- send_int(tt, 0)
- wait tt
+ $P0.'send'($I0)
+ $P1 = receive
+
+ if $I0 < 20 goto next_num
+ wait Res
.end
.sub test_sub
.local int sum
sum = 0
-loop:
- $P0 = recv
- $I0 = $P0
- if $I0 == 0 goto done
- sum = sum + $I0
- goto loop
-
-done:
- is(sum, 1060, "found first 25 primes")
+ $P0 = receive
+ is($P0, 2, "2 is prime")
+
+ $P0 = receive
+ is($P0, 3, "3 is prime")
+
+ $P0 = receive
+ is($P0, 5, "5 is prime")
+
+ $P0 = receive
+ is($P0, 7, "7 is prime")
+
+ $P0 = receive
+ is($P0, 11, "11 is prime")
+
+ $P0 = receive
+ is($P0, 13, "13 is prime")
+
+ $P0 = receive
+ is($P0, 17, "17 is prime")
+
+ $P0 = receive
+ is($P0, 19, "19 is prime")
.end
.sub send_int
@@ -85,23 +102,20 @@
M = recv
x = M
- if N >= 2 goto check_x
- N = x
- send_int(tt, x)
- goto send_reply
+ Nsq = N * N
+
+next_x:
+ $P0 = receive
+ $I0 = $P0
check_x:
$I0 = x % N
if $I0 != 0 goto maybe_prime
goto send_reply
-maybe_prime:
- unless null nt goto ship_it
- nt = make_checker()
-
-ship_it:
- nt.'send'(M)
- M = recv
+check_next:
+ nt.'send'($P0)
+ $P0 = receive
send_reply:
pt.'send'(M)
Deleted: branches/gsoc_threads/t/pmc/threads.t
==============================================================================
--- branches/gsoc_threads/t/pmc/threads.t Tue Aug 3 21:57:34 2010 (r48296)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,906 +0,0 @@
-#! perl
-# Copyright (C) 2001-2009, Parrot Foundation.
-# $Id$
-
-use strict;
-use warnings;
-use lib qw( . lib ../lib ../../lib );
-use Test::More;
-use Parrot::Test;
-use Parrot::Config;
-
-=head1 NAME
-
-t/pmc/threads.t - Threads
-
-=head1 SYNOPSIS
-
- % prove t/pmc/threads.t
-
-=head1 DESCRIPTION
-
-Tests running threads. All tests skipped unless running on known-good
-platform.
-
-=cut
-
-# Chandon TODO: Figure out the right thing to do.
-plan skip_all => "These thread tests are old.";
-exit(0);
-
-if ( $^O eq "cygwin" ) {
- my @uname = split / /, qx'uname -v';
-
- if ( $uname[0] eq "2004-09-04" ) {
- plan skip_all => "This cygwin version is known to fail the thread tests";
- exit;
- }
-}
-if ( $PConfig{HAS_THREADS} ) {
- plan tests => 14;
-}
-else {
- plan skip_all => "No threading enabled for '$^O'";
-}
-
-pasm_output_is( <<'CODE', <<'OUTPUT', "interp identity" );
- getinterp P2
- clone P3, P2
- ne P3, P2, ok1
- print "not"
-ok1:
- print "ok 1\n"
- new P4, ['ParrotThread']
- ne P2, P4, ok2
- print "not"
-ok2:
- print "ok 2\n"
- end
-CODE
-ok 1
-ok 2
-OUTPUT
-
-SKIP: {
- skip 'busted on win32' => 2 if $^O eq 'MSWin32';
-
- pir_output_is( <<'CODE', <<'OUTPUT', "thread type 1" );
-.sub main :main
- .local pmc threadfunc
- .local pmc thread
- $I5 = 10
- threadfunc = get_global "foo"
- thread = new ['ParrotThread']
- thread.'run_clone'(threadfunc)
-
- sleep 1
- print "main "
- print $I5
- print "\n"
- # get tid of thread
- $I0 = thread
- # wait for it
- thread.'join'()
-.end
-
-.sub foo
- # check if vars are fresh
- inc $I5
- print "thread"
- # print I5 # not done because registers aren't guaranteed to be
- # initialized to anything in particular
- print "\n"
- set $I3, 0 # no retval
- returncc # ret and be done with thread
-.end
-# output from threads could be reversed
-CODE
-thread
-main 10
-OUTPUT
-
- pir_output_is( <<'CODE', <<'OUTPUT', "thread type 1 -- repeated" );
-.sub real_main :main
- $I0 = 0
-loop:
- main()
- inc $I0
- if $I0 < 2 goto loop
-.end
-
-.sub main
- .local pmc threadfunc
- .local pmc thread
- $I5 = 10
- threadfunc = get_global "foo"
- thread = new ['ParrotThread']
- thread.'run_clone'(threadfunc)
-
- sleep 1
- print "main "
- print $I5
- print "\n"
- # get tid of thread
- $I0 = thread
- # wait for it
- thread.'join'()
-.end
-
-.sub foo
- # check if vars are fresh
- inc $I5
- print "thread"
- # print I5 # not done because registers aren't guaranteed to be
- # initialized to anything in particular
- print "\n"
- set $I3, 0 # no retval
- returncc # ret and be done with thread
-.end
-# output from threads could be reversed
-CODE
-thread
-main 10
-thread
-main 10
-OUTPUT
-}
-
-
-pir_output_is( <<'CODE', <<'OUTPUT', "thread type 2" );
-.sub main :main
- set $I5, 10
- .local pmc thread
- .local pmc threadsub
- $S5 = " interp\n"
- $P6 = new ['String']
- $P6 = 'from '
-
- print "ok 1\n"
- threadsub = get_global "foo"
- thread = new ['ParrotThread']
- thread.'run_clone'(threadsub, $P6)
- sleep 1 # to let the thread run
- print $P6
- print $I5
- print $S5
- thread.'join'()
-.end
-
-.sub foo
- .param pmc passed
- inc $I5
- $S5 = " thread\n"
- .local pmc salutation
- salutation = box 'hello from'
- print salutation
- # print I5 # not done because register initialization is not guaranteed
- print $S5
- $P0 = getinterp
- $S0 = typeof $P0
- print $S0
- print ' tid '
- $I0 = $P0
- print $I0
- print "\n"
-.end
-CODE
-ok 1
-hello from thread
-ThreadInterpreter tid 1
-from 10 interp
-OUTPUT
-
-
-pir_output_is( <<'CODE', <<'OUTPUT', 'thread - kill' );
-.sub main :main
- .local pmc threadsub
- .local pmc thread
- bounds 1 # assert slow core -S and -g are fine too
- threadsub = get_global "foo"
- thread = new ['ParrotThread']
- $I0 = thread
- print 'start '
- print $I0
- print "\n"
- thread.'run_clone'(threadsub)
-
- sleep 1 # to let the thread run
-
- thread.'kill'()
-
- print "done\n"
-.end
-
-.sub foo
- print "in thread\n"
- # run an endles loop
-lp:
- noop
- branch lp
-.end
-CODE
-start -1
-in thread
-done
-OUTPUT
-
-
-pir_output_is( <<'CODE', <<'OUTPUT', "join, get retval" );
-.sub _main
- .const int MAX = 1000
- .local pmc kid
- .local pmc Adder
- Adder = get_global '_add'
- kid = new ['ParrotThread']
- .local pmc from
- from = new ['Integer']
- from = 0
- .local pmc to
- to = new ['Integer']
- to = MAX
- kid.'run_clone'(Adder, Adder, from, to)
-
- .local pmc result
- result = kid.'join'()
- print result
- print "\n"
- # sum = n * (n + 1)/2
- .local pmc Mul
- Mul = new ['Integer']
- assign Mul, to
- inc Mul
- Mul = to * Mul
- Mul = Mul / 2
- print Mul
- print "\n"
- end
-.end
-
-.sub _add
- .param pmc sub
- .param pmc from
- .param pmc to
- .local pmc sum
- sum = new ['Integer']
-loop:
- add sum, from
- inc from
- le from, to, loop
-
- .begin_return
- .set_return sum
- .end_return
-.end
-CODE
-500500
-500500
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUT', "sub name lookup in new thread" );
-.sub check
- $P0 = get_global ['Foo'], 'foo'
- $I0 = isa $P0, 'Sub'
- if $I0 goto okay
- print "not "
-okay:
- print "ok\n"
-.end
-
-.sub main :main
- check()
- $P0 = new ['ParrotThread']
- .local pmc thread_main
- thread_main = get_global 'thread_main'
- $P0.'run_clone'(thread_main)
- $P0.'join'()
-.end
-
-.sub thread_main
- check()
-.end
-
-.namespace [ 'Foo' ]
-
-.sub foo
- print "not reached\n"
-.end
-CODE
-ok
-ok
-OUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "CLONE_CODE only" );
-
-.namespace [ 'Test2' ]
-.sub test2
- print "ok 2\n"
-.end
-
-.namespace [ 'Test3' ]
-.sub test3
- print "ok 3\n"
-.end
-
-.namespace [ 'main' ]
-
-.include 'errors.pasm'
-.sub thread_func
- .param pmc test2
- print "ok 1\n"
- test2()
- .local pmc test3
- test3 = get_hll_global ['Test3'], 'test3'
- test3()
- .local pmc test4
- errorsoff .PARROT_ERRORS_GLOBALS_FLAG
- test4 = get_global 'test4'
- if null test4 goto okay
- print "not "
-okay:
- print "ok 4\n"
-.end
-
-.include 'cloneflags.pasm'
-.sub main :main
- .local pmc test4
- .local pmc test2
-
- test2 = get_hll_global ['Test2'], 'test2'
-
- test4 = new ['Integer']
- test4 = 42
- set_global 'test4', test4
-
- .local pmc thread
- thread = new ['ParrotThread']
- .local pmc thread_func
- thread_func = get_global 'thread_func'
- $I0 = .PARROT_CLONE_CODE
- thread.'run'($I0, thread_func, test2)
- thread.'join'()
- print "ok 5\n"
-.end
-CODE
-ok 1
-ok 2
-ok 3
-ok 4
-ok 5
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "CLONE_CODE | CLONE_GLOBALS" );
-
-.namespace [ 'Foo' ]
-.sub 'is'
- .param pmc what
- .param pmc expect
- .param pmc label
- .param pmc shortlabel
- if what == expect goto okay
- print "# "
- print label
- print "\n"
- print "# got: "
- print what
- print "\n"
- print "# expected: "
- print expect
- print "\nnot "
-okay:
- print "ok "
- print shortlabel
- print "\n"
-.end
-
-.sub thread_test_func
- $P0 = get_hll_global [ 'Bar' ], 'alpha'
- 'is'($P0, 1, 'Bar::alpha == 1', 'alpha')
- $P0 = 43
- sleep 0.2 # give enough time that the main thread might modify
- # any shared Foo::beta can cause phantom errors
- $P0 = get_global 'beta'
- 'is'($P0, 2, 'Foo::beta == 2 [accessed locally]', 'beta1')
- $P0 = 5
- $P0 = get_global 'beta'
- 'is'($P0, 5, 'Foo::beta == 5 [accessed locally after assignment]', 'beta2')
- $P0 = get_hll_global [ 'Foo' ], 'beta'
- 'is'($P0, 5, 'Foo::beta == 5 [after assign; absolute]', 'beta3')
-.end
-
-.namespace [ 'main' ]
-
-.sub test_setup
- $P0 = new ['Integer']
- $P0 = 1
- set_hll_global [ 'Bar' ], 'alpha', $P0
- $P0 = new ['Integer']
- $P0 = 2
- set_hll_global [ 'Foo' ], 'beta', $P0
-.end
-
-.include 'cloneflags.pasm'
-.sub main :main
- 'test_setup'()
-
- .local pmc thread
- thread = new ['ParrotThread']
- .local pmc _thread_func
- _thread_func = get_hll_global [ 'Foo' ], 'thread_test_func'
- $I0 = .PARROT_CLONE_CODE
- bor $I0, $I0, .PARROT_CLONE_GLOBALS
- print "in thread:\n"
- thread.'run'($I0, _thread_func)
- $P0 = get_hll_global [ 'Foo' ], 'beta'
- $P0 = 42
- thread.'join'()
- print "in main:\n"
- $P0 = 2
- _thread_func()
-.end
-CODE
-in thread:
-ok alpha
-ok beta1
-ok beta2
-ok beta3
-in main:
-ok alpha
-ok beta1
-ok beta2
-ok beta3
-OUTPUT
-
-TODO: {
- local $TODO = "vtable overrides aren't properly cloned TT # 1248";
-
- pir_output_is( <<'CODE', <<'OUTPUT', "CLONE_CODE | CLONE_CLASSES; superclass not built-in" );
-.namespace [ 'Foo' ]
-
-.sub foometh :method
- print "called Foo's foometh\n"
-.end
-
-.sub barmeth :method
- print "called Foo's barmeth\n"
-.end
-
-.namespace [ 'Bar' ]
-
-.sub barmeth :method
- print "called Bar's barmeth\n"
-.end
-
-.sub get_string :vtable :method
- .return ("A Bar")
-.end
-
-.namespace [ 'main' ]
-
-.sub init
- $P1 = newclass 'Foo'
- addattribute $P1, 'foo1'
- addattribute $P1, 'foo2'
- $P2 = subclass $P1, 'Bar'
- addattribute $P2, 'bar1'
-.end
-
-.sub thread_test_func
- $P0 = new ['Bar']
- print $P0
- print "\n"
- $P0.'barmeth'()
- $P0.'foometh'()
- $I0 = isa $P0, 'Integer'
- print "Integer? "
- print $I0
- print "\n"
- $I0 = isa $P0, 'Foo'
- print "Foo? "
- print $I0
- print "\n"
- $I0 = isa $P0, 'Bar'
- print "Bar? "
- print $I0
- print "\n"
-.end
-
-.include 'cloneflags.pasm'
-.sub main :main
- init()
-
- .local pmc thread
- thread = new ['ParrotThread']
- .local pmc _thread_func
- _thread_func = get_hll_global ['main'], 'thread_test_func'
- $I0 = .PARROT_CLONE_CODE
- bor $I0, $I0, .PARROT_CLONE_CLASSES
- print "in thread:\n"
- thread.'run'($I0, _thread_func)
- thread.'join'()
- print "in main:\n"
- _thread_func()
-.end
-CODE
-in thread:
-A Bar
-called Bar's barmeth
-called Foo's foometh
-Integer? 0
-Foo? 1
-Bar? 1
-in main:
-A Bar
-called Bar's barmeth
-called Foo's foometh
-Integer? 0
-Foo? 1
-Bar? 1
-OUTPUT
-}
-
-pir_output_is( <<'CODE', <<'OUTPUT', "CLONE_CODE | CLONE_CLASSES; superclass built-in", todo => 'likely incorrect test TT 1248');
-.namespace [ 'Foo' ]
-
-.sub foometh :method
- print "called Foo's foometh\n"
-.end
-
-.sub barmeth :method
- print "called Foo's barmeth\n"
-.end
-
-.namespace [ 'Bar' ]
-
-.sub barmeth :method
- print "called Bar's barmeth\n"
-.end
-
-.sub get_string :vtable :method
- .return ("A Bar")
-.end
-
-.namespace [ 'main' ]
-
-.sub init
- $P0 = get_class 'Integer'
- $P1 = subclass $P0, 'Foo'
- addattribute $P1, 'foo1'
- addattribute $P1, 'foo2'
- $P2 = subclass $P1, 'Bar'
- addattribute $P2, 'bar1'
-.end
-
-.sub thread_test_func
- $P0 = new ['Bar']
- print $P0
- print "\n"
- $P0.'barmeth'()
- $P0.'foometh'()
- $I0 = isa $P0, 'Integer'
- print "Integer? "
- print $I0
- print "\n"
- $I0 = isa $P0, 'Foo'
- print "Foo? "
- print $I0
- print "\n"
- $I0 = isa $P0, 'Bar'
- print "Bar? "
- print $I0
- print "\n"
-.end
-
-.include 'cloneflags.pasm'
-.sub main :main
- init()
-
- .local pmc thread
- thread = new ['ParrotThread']
- .local pmc _thread_func
- _thread_func = get_global 'thread_test_func'
- $I0 = .PARROT_CLONE_CODE
- bor $I0, $I0, .PARROT_CLONE_CLASSES
- print "in thread:\n"
- thread.'run'($I0, _thread_func)
- thread.'join'()
- print "in main:\n"
- _thread_func()
-.end
-CODE
-in thread:
-A Bar
-called Bar's barmeth
-called Foo's foometh
-Integer? 1
-Foo? 1
-Bar? 1
-in main:
-A Bar
-called Bar's barmeth
-called Foo's foometh
-Integer? 1
-Foo? 1
-Bar? 1
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "CLONE_CODE | CLONE_GLOBALS| CLONE_HLL" );
-.HLL 'Test'
-.sub setup
- $P0 = new ['Integer']
- $P0 = 42
- set_global 'x', $P0
-.end
-
-.include 'interpinfo.pasm'
-.sub test
- $P0 = get_global 'x'
- if $P0 == 42 goto okay1
- print "not "
-okay1:
- print "ok 1\n"
- $P1 = get_root_namespace
- $P1 = $P1['test']
- $P1 = $P1['x']
- $P1 = 43
- if $P0 == 43 goto okay2
- print "not "
-okay2:
- print "ok 2\n"
-.end
-
-.HLL ''
-
-.include 'cloneflags.pasm'
-
-.sub main :main
- .local pmc setup
- .local pmc test
- setup = get_root_namespace
- setup = setup['test']
- test = setup['test']
- setup = setup['setup']
- setup()
-
- .local pmc thread
- .local int flags
- thread = new ['ParrotThread']
- flags = .PARROT_CLONE_CODE
- bor flags, flags, .PARROT_CLONE_GLOBALS
- bor flags, flags, .PARROT_CLONE_HLL
- print "in thread:\n"
- thread.'run'(flags, test)
- thread.'join'()
- print "in main:\n"
- test()
-.end
-CODE
-in thread:
-ok 1
-ok 2
-in main:
-ok 1
-ok 2
-OUTPUT
-
-# Direct constant access to sub objects commented out, see TT #1120.
-pir_output_unlike( <<'CODE', qr/not/, "globals + constant table subs issue");
-.namespace [ 'Foo' ]
-
-.include 'interpinfo.pasm'
-.sub 'is'
- .param pmc what
- .param pmc expect
- .param string desc :optional
- .param int have_desc :opt_flag
-
- unless have_desc goto diagnose
- desc = ' - ' . desc
-
- diagnose:
- .local pmc number
- number = get_global 'test_num'
- if what == expect goto okay
- print "# got: "
- say what
- print "# expected: "
- say expect
- print "not ok "
- print number
- say desc
- inc number
- $P0 = interpinfo .INTERPINFO_CURRENT_CONT
-loop:
- $I0 = defined $P0
- if $I0 == 0 goto done
- print " "
- say $P0
- $P0 = $P0.'continuation'()
- branch loop
-done:
- .return ()
-okay:
- print "ok "
- print number
- inc number
- say desc
-.end
-
-.sub setup
- $P0 = new ['Integer']
- $P0 = 1
- set_global 'foo', $P0
-.end
-
-.sub _check_sanity
- .param string desc
- $P0 = get_global 'foo'
- $P1 = get_hll_global [ 'Foo' ], 'foo'
- is($P0, $P1, desc)
-.end
-
-.sub mutate
- $P0 = new ['Integer']
- $P0 = 2
- set_global 'foo', $P0
-.end
-
-.sub check_sanity
-# _check_sanity( 'direct call' )
- $P0 = get_global '_check_sanity'
- $P0( 'call from get_global' )
- $P0 = get_hll_global [ 'Foo' ], '_check_sanity'
- $P0( 'call from get_hll_global' )
-.end
-
-.sub _check_value
- .param int value
- $P0 = get_global 'foo'
- is($P0, value)
-.end
-
-.sub check_value
- .param int value
-# _check_value(value)
- $P0 = get_global '_check_value'
- $P0(value)
- $P0 = get_hll_global [ 'Foo' ], '_check_value'
- $P0(value)
-.end
-
-.sub full_check
-# .const 'Sub' c_setup = 'setup'
-# .const 'Sub' c_sanity = 'check_sanity'
-# .const 'Sub' c_mutate = 'mutate'
-# .const 'Sub' c_value = 'check_value'
-
- .local pmc c_setup
- c_setup = get_global 'setup'
- .local pmc c_sanity
- c_sanity = get_global 'check_sanity'
- .local pmc c_mutate
- c_mutate = get_global 'mutate'
- .local pmc c_value
- c_value = get_global 'check_value'
-
- .local pmc g_setup
- g_setup = get_hll_global [ 'Foo' ], 'setup'
- .local pmc g_sanity
- g_sanity = get_hll_global [ 'Foo' ], 'check_sanity'
- .local pmc g_mutate
- g_mutate = get_hll_global [ 'Foo' ], 'mutate'
- .local pmc g_value
- g_value = get_hll_global [ 'Foo' ], 'check_value'
-
- c_setup()
- c_sanity()
- g_sanity()
- c_value(1)
- g_value(1)
- c_mutate()
- c_value(2)
- g_value(2)
- c_sanity()
- g_sanity()
-
- g_setup()
- c_sanity()
- g_sanity()
- c_value(1)
- g_value(1)
- g_mutate()
- c_value(2)
- g_value(2)
- c_sanity()
- g_sanity()
-.end
-
-
-
-.sub main :main
- $P0 = new ['Integer']
- $P0 = 1
- set_global 'test_num', $P0
-
- .const 'Sub' _check = 'full_check'
- _check()
-
- $P0 = new ['ParrotThread']
- $P0.'run_clone'(_check)
- $P0.'join'()
-.end
-CODE
-
-pir_output_is(
- <<'CODE', <<'OUTPUT', 'CLONE_CODE|CLONE_GLOBALS|CLONE_HLL|CLONE_LIBRARIES - TT # 1250' );
-.HLL 'Perl'
-
-.include 'interpinfo.pasm'
-
-.loadlib 'foo_group'
-
-.sub test
- .param pmc passed_value
- .local pmc the_value
- the_value = new ['Integer']
- the_value = 42
- set_hll_global ['Foo'], 'x', the_value
- $S0 = typeof passed_value
- $S1 = typeof the_value
- $I0 = iseq $S0, $S1
- say $I0
-
- .local pmc ns
- ns = get_namespace ['Foo']
- $P0 = interpinfo .INTERPINFO_CURRENT_SUB
- ns = $P0.'get_namespace'()
- ns = ns['Foo']
- $P0 = ns['x']
- if $P0 == the_value goto okay
- print "not "
-okay:
- say "ok (equal)"
-
- $I0 = the_value
- say $I0
-.end
-
-.include 'cloneflags.pasm'
-
-.sub main :main
- .local pmc thread
- .local int flags
- thread = new ['ParrotThread']
- flags = .PARROT_CLONE_CODE
- bor flags, flags, .PARROT_CLONE_GLOBALS
- bor flags, flags, .PARROT_CLONE_HLL
- bor flags, flags, .PARROT_CLONE_LIBRARIES
-
- .local pmc passed
- passed = new ['Foo']
- passed = 15
-
- .local pmc thread_func
- thread_func = get_global 'test'
- say "in thread:"
- thread.'run'(flags, thread_func, passed)
- thread.'join'()
- say "in main:"
- thread_func(passed)
-.end
-CODE
-in thread:
-0
-ok (equal)
-42
-in main:
-0
-ok (equal)
-42
-OUTPUT
-
-# Local Variables:
-# mode: cperl
-# cperl-indent-level: 4
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4:
More information about the parrot-commits
mailing list