[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