Ticket #192: tqueue.deprecated.patch

File tqueue.deprecated.patch, 20.2 KB (added by jkeenan, 5 years ago)

Patch developed in deprecate_tqueue branch

  • src/pmc/tqueue.pmc

     
    1 /* 
    2 Copyright (C) 2001-2008, Parrot Foundation. 
    3 $Id$ 
    4  
    5 =head1 NAME 
    6  
    7 src/pmc/tqueue.pmc - Threadsafe Queue 
    8  
    9 =head1 DESCRIPTION 
    10  
    11 Threadsafe queue class for inter thread communication. If you have an 
    12 unthreaded program then please use an Array-like PMC. 
    13  
    14      new P0, 'TQueue' 
    15      push P0, some 
    16      new P2, 'ParrotThread' 
    17      ... 
    18  
    19 and in other thread (at least, when shared PMCs work :) 
    20  
    21      shift P1, P0 
    22  
    23 Note: The TQueue must always be emptied before program exit. 
    24  
    25 =head2 Methods 
    26  
    27 =over 4 
    28  
    29 =cut 
    30  
    31 */ 
    32  
    33 #include "parrot/parrot.h" 
    34  
    35 pmclass TQueue need_ext is_shared { 
    36     ATTR struct QUEUE *queue; 
    37     ATTR INTVAL        thread_count; 
    38  
    39 /* 
    40  
    41 =item C<void init()> 
    42  
    43 Initializes the queue. 
    44  
    45 =cut 
    46  
    47 */ 
    48  
    49     VTABLE void init() { 
    50         Parrot_TQueue_attributes* attrs = 
    51             mem_allocate_zeroed_typed(Parrot_TQueue_attributes); 
    52  
    53         attrs->thread_count = 0; 
    54         attrs->queue        = queue_init(0); 
    55         PMC_data(SELF)      = attrs; 
    56  
    57         PObj_custom_mark_destroy_SETALL(SELF); 
    58     } 
    59  
    60 /* 
    61  
    62 =item C<PMC *clone()> 
    63  
    64 Returns the queue itself. No copy is made. 
    65  
    66 =cut 
    67  
    68 */ 
    69  
    70     VTABLE PMC *clone() { 
    71         /* XXX fake a shared PMC */ 
    72         return SELF; 
    73     } 
    74  
    75 /* 
    76  
    77 =item C<void mark()> 
    78  
    79 Marks all the threads in the queue as live. 
    80  
    81 =cut 
    82  
    83 */ 
    84  
    85     VTABLE void mark() { 
    86         QUEUE       *queue; 
    87         QUEUE_ENTRY *entry; 
    88  
    89         GET_ATTR_queue(INTERP, SELF, queue); 
    90  
    91         queue_lock(queue); 
    92         entry = queue->head; 
    93  
    94         while (entry) { 
    95             pobject_lives(INTERP, (PObj *)entry->data); 
    96  
    97             if (entry == queue->tail) 
    98                 break; 
    99  
    100             entry = entry->next; 
    101         } 
    102  
    103         queue_unlock(queue); 
    104     } 
    105  
    106 /* 
    107  
    108 =item C<void destroy()> 
    109  
    110 Destroys the queue. 
    111  
    112 =cut 
    113  
    114 */ 
    115  
    116     VTABLE void destroy() { 
    117         QUEUE *queue; 
    118         GET_ATTR_queue(INTERP, SELF, queue); 
    119  
    120         if (queue) { 
    121 #if 0 
    122             /* 
    123              * wait til queue is empty 
    124              * XXX implement a time wait and PANIC if queue 
    125              * isn't empty after some TIMEOUT 
    126              */ 
    127             while (SELF.elements()) { 
    128                 queue_lock(queue); 
    129                 queue_wait(queue); 
    130                 queue_unlock(queue); 
    131             } 
    132 #endif 
    133             mem_sys_free(queue); 
    134         } 
    135         mem_sys_free(PMC_data(SELF)); 
    136     } 
    137  
    138 /* 
    139  
    140 =item C<INTVAL defined()> 
    141  
    142 Returns whether there are any threads in the queue. 
    143  
    144 =cut 
    145  
    146 */ 
    147  
    148     VTABLE INTVAL defined() { 
    149         return SELF.get_integer() != 0; 
    150     } 
    151  
    152 /* 
    153  
    154 =item C<INTVAL get_integer()> 
    155  
    156 =cut 
    157  
    158 */ 
    159  
    160     VTABLE INTVAL get_integer() { 
    161  
    162         INTVAL thread_count; 
    163         GET_ATTR_thread_count(INTERP, SELF, thread_count); 
    164         return thread_count; 
    165     } 
    166  
    167 /* 
    168  
    169 =item C<INTVAL elements()> 
    170  
    171 Returns the number of threads in the queue. 
    172  
    173 =cut 
    174  
    175 */ 
    176  
    177     VTABLE INTVAL elements() { 
    178         return SELF.get_integer(); 
    179     } 
    180  
    181 /* 
    182  
    183 =item C<void push_pmc(PMC *item)> 
    184  
    185 Adds the thread C<*item> to the end of the queue. 
    186  
    187 =cut 
    188  
    189 */ 
    190  
    191     void push_pmc(PMC *item) { 
    192         QUEUE_ENTRY * const entry = mem_allocate_typed(QUEUE_ENTRY); 
    193         QUEUE       *       queue; 
    194         INTVAL       thread_count; 
    195  
    196         GET_ATTR_queue(INTERP, SELF, queue); 
    197  
    198         /* 
    199          * if item isn't shared nor const, then make 
    200          *       a shared item 
    201          */ 
    202         if (!(item->vtable->flags & 
    203                     (VTABLE_IS_CONST_FLAG | VTABLE_IS_SHARED_FLAG))) 
    204             VTABLE_share(INTERP, item); 
    205  
    206         GC_WRITE_BARRIER(INTERP, SELF, NULL, item); 
    207  
    208         entry->data = item; 
    209         entry->type = QUEUE_ENTRY_TYPE_NONE; 
    210  
    211         /* s. tsq.c:queue_push */ 
    212         queue_lock(queue); 
    213  
    214         GET_ATTR_thread_count(INTERP, SELF, thread_count); 
    215         ++thread_count; 
    216         SET_ATTR_thread_count(INTERP, SELF, thread_count); 
    217  
    218         /* Is there something in the queue? */ 
    219         if (queue->tail) { 
    220             queue->tail->next = entry; 
    221             queue->tail       = entry; 
    222         } 
    223         else { 
    224             queue->head = entry; 
    225             queue->tail = entry; 
    226         } 
    227  
    228         /* signal all waiters */ 
    229         queue_broadcast(queue); 
    230         queue_unlock(queue); 
    231     } 
    232  
    233 /* 
    234  
    235 =item C<PMC *shift_pmc()> 
    236  
    237 Removes the first thread from the start of the queue. 
    238  
    239 =cut 
    240  
    241 */ 
    242  
    243     VTABLE PMC *shift_pmc() { 
    244         QUEUE       *queue; 
    245         QUEUE_ENTRY *entry; 
    246         PMC         *ret; 
    247         INTVAL       thread_count; 
    248  
    249         GET_ATTR_queue(INTERP, SELF, queue); 
    250         queue_lock(queue); 
    251  
    252         while (queue->head == NULL) { 
    253             queue_wait(queue); 
    254         } 
    255  
    256         entry = nosync_pop_entry(queue); 
    257         GET_ATTR_thread_count(INTERP, SELF, thread_count); 
    258         --thread_count; 
    259         SET_ATTR_thread_count(INTERP, SELF, thread_count); 
    260  
    261         queue_unlock(queue); 
    262  
    263         ret   = (PMC *)entry->data; 
    264         mem_sys_free(entry); 
    265  
    266         return ret; 
    267     } 
    268 } 
    269  
    270 /* 
    271  
    272 =back 
    273  
    274 =cut 
    275  
    276 */ 
    277  
    278 /* 
    279  * Local variables: 
    280  *   c-file-style: "parrot" 
    281  * End: 
    282  * vim: expandtab shiftwidth=4: 
    283  */ 
  • src/pmc/pmc.num

     
    7575 
    7676# other 
    7777 
    78 tqueue.pmc    50 
     78parrotclass.pmc    50 
     79parrotobject.pmc    51 
    7980 
    80 parrotclass.pmc    51 
    81 parrotobject.pmc    52 
    82  
    83 os.pmc    53 
    84 file.pmc    54 
     81os.pmc    52 
     82file.pmc    53 
  • MANIFEST

     
    11# ex: set ro: 
    22# $Id$ 
    33# 
    4 # generated by tools/dev/mk_manifest_and_skip.pl Wed Feb 25 17:00:32 2009 UT 
     4# generated by tools/dev/mk_manifest_and_skip.pl Thu Feb 26 01:36:56 2009 UT 
    55# 
    66# See tools/dev/install_files.pl for documentation on the 
    77# format of this file. 
     
    717717examples/pir/readline.pir                                   [examples] 
    718718examples/pir/substr.pir                                     [examples] 
    719719examples/pir/sudoku.pir                                     [examples] 
    720 examples/pir/thr-primes.pir                                 [examples] 
    721720examples/pir/uniq.pir                                       [examples] 
    722721examples/sdl/anim_image.pir                                 [examples] 
    723722examples/sdl/anim_image_dblbuf.pir                          [examples] 
     
    23222321src/pmc/sub.pmc                                             [devel]src 
    23232322src/pmc/task.pmc                                            [devel]src 
    23242323src/pmc/timer.pmc                                           [devel]src 
    2325 src/pmc/tqueue.pmc                                          [devel]src 
    23262324src/pmc/undef.pmc                                           [devel]src 
    23272325src/pmc/unmanagedstruct.pmc                                 [devel]src 
    23282326src/pmc_freeze.c                                            [] 
     
    27702768t/pmc/task.t                                                [test] 
    27712769t/pmc/threads.t                                             [test] 
    27722770t/pmc/timer.t                                               [test] 
    2773 t/pmc/tqueue.t                                              [test] 
    27742771t/pmc/undef.t                                               [test] 
    27752772t/pmc/unmanagedstruct.t                                     [test] 
    27762773t/postconfigure/01-options.t                                [test] 
  • editor/pir-mode.el

     
    156156    "ParrotRunningThread" "ParrotThread" "Pointer" "Random" "Ref" 
    157157    "ResizableBooleanArray" "ResizableFloatArray" "ResizableIntegerArray" 
    158158    "ResizablePMCArray" "ResizableStringArray" "RetContinuation" 
    159     "Role" "Scalar" "SharedRef" "Slice" "String" "Sub" "Super" "TQueue" 
     159    "Role" "Scalar" "SharedRef" "Slice" "String" "Sub" "Super" 
    160160    "Timer" "UnManagedStruct" "Undef" "VtableCache")) 
    161161 
    162162(defvar pir-ops 
  • t/pmc/tqueue.t

     
    1 #! parrot 
    2 # Copyright (C) 2001-2005, Parrot Foundation. 
    3 # $Id$ 
    4  
    5 =head1 NAME 
    6  
    7 t/pmc/tqueue.t - Thread Queue 
    8  
    9 =head1 SYNOPSIS 
    10  
    11     % prove t/pmc/tqueue.t 
    12  
    13 =head1 DESCRIPTION 
    14  
    15 Tests the thread queue. 
    16  
    17 =cut 
    18  
    19 .sub main :main 
    20     .include "include/test_more.pir" 
    21     plan(5) 
    22     thread_safe_queue_tests() 
    23 .end 
    24  
    25 .sub thread_safe_queue_tests 
    26     .local int i, is_ok 
    27     .local pmc tq, pInt 
    28  
    29     new tq, ['TQueue'] 
    30     ok(1, "didn't crash") 
    31  
    32     i = tq 
    33     is_ok = i == 0 
    34     ok(is_ok, "int assignment gets # of elements in empty queue") 
    35  
    36     pInt = new ['Integer'] 
    37     pInt = 2 
    38     push tq, pInt 
    39     pInt = new ['Integer'] 
    40     pInt = 3 
    41     push tq, pInt 
    42     i = tq 
    43     is_ok = i == 2 
    44     ok(is_ok, "int assignment gets # of elements in non-empty queue") 
    45  
    46     shift pInt, tq 
    47     i = pInt 
    48     is_ok = i == 2 
    49     ok(is_ok, "int retrieval works") 
    50     shift pInt, tq 
    51     i = pInt 
    52     is_ok = i == 3 
    53     ok(is_ok, "int retrieval works") 
    54 .end 
    55  
    56 # Local Variables: 
    57 #   mode: pir 
    58 #   cperl-indent-level: 4 
    59 #   fill-column: 100 
    60 # End: 
    61 # vim: expandtab shiftwidth=4 ft=pir: 
  • t/pmc/threads.t

     
    4646    } 
    4747} 
    4848if ( $platforms{$^O} ) { 
    49     plan tests => 20; 
     49    plan tests => 15; 
    5050} 
    5151else { 
    5252    plan skip_all => "No threading yet or test not enabled for '$^O'"; 
     
    288288500500 
    289289OUTPUT 
    290290 
    291  
    292 pir_output_like( <<'CODE', <<'OUTPUT', "detach" ); 
    293 .sub main :main 
    294     .local pmc foo 
    295     .local pmc queue 
    296     .local pmc thread 
    297     foo = get_global '_foo' 
    298     queue = new ['TQueue'] # flag for when the thread is done 
    299     thread = new ['ParrotThread'] 
    300     thread.'run_clone'(foo, queue) 
    301  
    302     thread.'detach'() 
    303 wait: 
    304     defined $I0, queue 
    305     if $I0 == 0 goto wait 
    306     print "done\n" 
    307 .end 
    308  
    309 .sub _foo 
    310     .param pmc queue 
    311     print "thread\n" 
    312     sleep 0.1 
    313     $P1 = new ['Integer'] 
    314     push queue, $P1 
    315 .end 
    316 CODE 
    317 /(done\nthread\n)|(thread\ndone\n)/ 
    318 OUTPUT 
    319  
    320  
    321291pir_output_is( <<'CODE', <<'OUTPUT', "share a PMC" ); 
    322292.sub main :main 
    323293    .local pmc foo 
     
    35432421 
    355325OUTPUT 
    356326 
    357 pir_output_is( <<'CODE', <<'OUT', "multi-threaded" ); 
    358 .sub main :main 
    359     .local pmc queue 
    360     queue = new ['TQueue'] 
    361     .local pmc tmpInt 
    362     tmpInt = new ['Integer'] 
    363     tmpInt = 1 
    364     push queue, tmpInt 
    365     tmpInt = new ['Integer'] 
    366     tmpInt = 2 
    367     push queue, tmpInt 
    368     tmpInt = new ['Integer'] 
    369     tmpInt = 3 
    370     push queue, tmpInt 
    371  
    372     .local pmc thread 
    373     thread = new ['ParrotThread'] 
    374     .local pmc foo 
    375     foo = get_global '_foo' 
    376     thread.'run_clone'(foo, queue) 
    377     thread.'join'() 
    378     print "done main\n" 
    379 .end 
    380  
    381 .sub _foo 
    382     .param pmc queue 
    383     $I0 = queue 
    384     print $I0 
    385     print "\n" 
    386 loop: 
    387     $I0 = queue 
    388     if $I0 == 0 goto done 
    389     shift $P0, queue 
    390     print $P0 
    391     print "\n" 
    392     branch loop 
    393 done: 
    394     print "done thread\n" 
    395 .end 
    396 CODE 
    397 3 
    398 1 
    399 2 
    400 3 
    401 done thread 
    402 done main 
    403 OUT 
    404  
    405327pir_output_is( <<'CODE', <<'OUT', "sub name lookup in new thread" ); 
    406328.sub check 
    407329    $P0 = get_global ['Foo'], 'foo' 
     
    101693842 
    1017939OUTPUT 
    1018940 
    1019 pir_output_is( <<'CODE', <<'OUT', 'multi-threaded strings via SharedRef' ); 
    1020 .sub main :main 
    1021     .local pmc queue 
    1022     .local pmc tmp_string 
    1023     .local pmc shared_ref 
    1024  
    1025     queue = new ['TQueue'] 
    1026     tmp_string = new ['String'] 
    1027     tmp_string = "ok 1\n" 
    1028     shared_ref = new ['SharedRef'], tmp_string 
    1029     push queue, shared_ref 
    1030     tmp_string = new ['String'] 
    1031     tmp_string = "ok 2\n" 
    1032     shared_ref = new ['SharedRef'], tmp_string 
    1033     push queue, shared_ref 
    1034     tmp_string = new ['String'] 
    1035     tmp_string = "ok 3\n" 
    1036     shared_ref = new ['SharedRef'], tmp_string 
    1037     push queue, shared_ref 
    1038  
    1039     .local pmc thread 
    1040     .local pmc foo 
    1041  
    1042     thread = new ['ParrotThread'] 
    1043     foo = get_global '_foo' 
    1044     thread.'run_clone'(foo, queue) 
    1045     thread.'join'() 
    1046     print "done main\n" 
    1047 .end 
    1048  
    1049 .sub _foo 
    1050     .param pmc queue 
    1051     $I0 = queue 
    1052     print $I0 
    1053     print "\n" 
    1054 loop: 
    1055     $I0 = queue 
    1056     if $I0 == 0 goto done 
    1057     shift $P0, queue 
    1058     print $P0 
    1059     branch loop 
    1060 done: 
    1061     print "done thread\n" 
    1062 .end 
    1063 CODE 
    1064 3 
    1065 ok 1 
    1066 ok 2 
    1067 ok 3 
    1068 done thread 
    1069 done main 
    1070 OUT 
    1071  
    1072 SKIP: { 
    1073     skip( "no shared Strings yet", 2 ); 
    1074     pasm_output_is( <<'CODE', <<'OUT', "thread safe queue strings 1" ); 
    1075     new P10, ['TQueue'] 
    1076     print "ok 1\n" 
    1077     set I0, P10 
    1078     print I0 
    1079     print "\n" 
    1080     new P7, ['String'] 
    1081     set P7, "ok 2\n" 
    1082     push P10, P7 
    1083     new P7, ['String'] 
    1084     set P7, "ok 3\n" 
    1085     push P10, P7 
    1086     set I0, P10 
    1087     print I0 
    1088     print "\n" 
    1089  
    1090     shift P8, P10 
    1091     print P8 
    1092     shift P8, P10 
    1093     print P8 
    1094     end 
    1095 CODE 
    1096 ok 1 
    1097 0 
    1098 2 
    1099 ok 2 
    1100 ok 3 
    1101 OUT 
    1102  
    1103     pasm_output_is( <<'CODE', <<'OUT', "multi-threaded strings" ); 
    1104     new P10, ['TQueue'] 
    1105     new P7, ['String'] 
    1106     set P7, "ok 1\n" 
    1107     push P10, P7 
    1108     new P7, ['String'] 
    1109     set P7, "ok 2\n" 
    1110     push P10, P7 
    1111     new P7, ['String'] 
    1112     set P7, "ok 3\n" 
    1113     push P10, P7 
    1114     set P6, P10 
    1115  
    1116     get_global P5, "_foo" 
    1117     new P2, ['ParrotThread'] 
    1118     callmethod "thread3" 
    1119     set I5, P2 
    1120     getinterp P2 
    1121     callmethod "join" 
    1122     print "done main\n" 
    1123     end 
    1124  
    1125 .pcc_sub _foo: 
    1126     set I0, P6 
    1127     print I0 
    1128     print "\n" 
    1129 loop: 
    1130     set I0, P6 
    1131     unless I0, ex 
    1132     shift P8, P6 
    1133     print P8 
    1134     branch loop 
    1135 ex: 
    1136     print "done thread\n" 
    1137     returncc 
    1138 CODE 
    1139 3 
    1140 ok 1 
    1141 ok 2 
    1142 ok 3 
    1143 done thread 
    1144 done main 
    1145 OUT 
    1146 } 
    1147  
    1148941# Local Variables: 
    1149942#   mode: cperl 
    1150943#   cperl-indent-level: 4 
  • t/steps/auto_pmc-01.t

     
    184184    fixedstringarray.pmc 
    185185    hash.pmc 
    186186    orderedhash.pmc 
    187     tqueue.pmc 
    188187    os.pmc 
    189188    file.pmc 
    190189    addrregistry.pmc 
  • t/op/gc.t

     
    66use warnings; 
    77use lib qw( . lib ../lib ../../lib ); 
    88use Test::More; 
    9 use Parrot::Test tests => 20; 
     9use Parrot::Test tests => 19; 
    1010 
    1111=head1 NAME 
    1212 
     
    474474ok 
    475475OUTPUT 
    476476 
    477 pasm_output_is( <<'CODE', <<OUTPUT, "write barrier 4 - tqueue" ); 
    478     null I2 
    479     set I3, 100 
    480 lp3: 
    481     null I0 
    482     set I1, 10 
    483     new P5, 'TQueue' 
    484     new P0, 'Integer' 
    485     needs_destroy P0 
    486     # force partial sweep 
    487     # P5 should now be black 
    488     sweep 0 
    489     # store white queue P1 in black P5 - needs a barrier 
    490     new P1, 'TQueue' 
    491     push P5, P1 
    492     null P1 
    493     new P0, 'Integer' 
    494     needs_destroy P0 
    495     # force  sweep 
    496     sweep 0 
    497     shift P1, P5 
    498     push P5, P1 
    499 lp1: 
    500     new P0, 'Integer' 
    501     needs_destroy P0 
    502     # force  sweep 
    503     sweep 0 
    504     set P0, I0 
    505     new P2, 'TQueue' 
    506     push P2, P0 
    507     push P1, P2 
    508     new P3, 'Undef' 
    509     new P4, 'Undef' 
    510     inc I0 
    511     lt I0, I1, lp1 
    512  
    513     null I0 
    514     shift P1, P5 
    515 lp2: 
    516     shift P2, P1 
    517     shift P2, P2 
    518     eq P2, I0, ok 
    519     print "nok\n" 
    520     print "I0: " 
    521     print I0 
    522     print " P2: " 
    523     print P2 
    524     print " type: " 
    525     typeof S0, P2 
    526     print S0 
    527     print " I2: " 
    528     print I2 
    529     print "\n" 
    530     exit 1 
    531 ok: 
    532     inc I0 
    533     lt I0, I1, lp2 
    534     inc I2 
    535     lt I2, I3, lp3 
    536     print "ok\n" 
    537     end 
    538  
    539 CODE 
    540 ok 
    541 OUTPUT 
    542  
    543477pir_output_is( <<'CODE', <<'OUTPUT', "verify pmc proxy object marking" ); 
    544478.sub main :main 
    545479    .local pmc cl, s, t 
  • examples/pir/thr-primes.pir

     
    1 # Copyright (C) 2001-2008, Parrot Foundation. 
    2 # $Id$ 
    3  
    4 =head1 NAME 
    5  
    6 examples/pir/thr-primes.pir - Threads 
    7  
    8 =head1 SYNOPSIS 
    9  
    10     % ./parrot examples/pir/thr-primes.pir 
    11  
    12 =head1 DESCRIPTION 
    13  
    14 A threaded primes example. 
    15  
    16 From C<perldoc perlthrtut>: 
    17  
    18     1  #!/usr/bin/perl -w 
    19     2  # prime-pthread, courtesy of Tom Christiansen 
    20     3 
    21     4  use strict; 
    22     5 
    23     6  use threads; 
    24     7  use Thread::Queue; 
    25     8 
    26     9  my $stream = new Thread::Queue; 
    27     10 my $kid    = new threads(\&check_num, $stream, 2); 
    28     11 
    29     12 for my $i ( 3 .. 1000 ) { 
    30     13     $stream->enqueue($i); 
    31     14 } 
    32     15 
    33     16 $stream->enqueue(undef); 
    34     17 $kid->join; 
    35     18 
    36     19 sub check_num { 
    37     20     my ($upstream, $cur_prime) = @_; 
    38     21     my $kid; 
    39     22     my $downstream = new Thread::Queue; 
    40     23     while (my $num = $upstream->dequeue) { 
    41     24         next unless $num % $cur_prime; 
    42     25         if ($kid) { 
    43     26            $downstream->enqueue($num); 
    44     27                  } else { 
    45     28            print "Found prime $num\n"; 
    46     29                $kid = new threads(\&check_num, $downstream, $num); 
    47     30         } 
    48     31     } 
    49     32     $downstream->enqueue(undef) if $kid; 
    50     33     $kid->join           if $kid; 
    51     34 } 
    52  
    53 =cut 
    54  
    55 # translate to PIR by leo 
    56  
    57 # Runs here (i386/linux 256MB mem) w. 
    58 #  ARENA_GC_FLAGS = 1    MAX=500   (~  95 threads) 
    59 #  ARENA_GC_FLAGS = 0    MAX=1000  (~ 168 threads) 
    60  
    61  
    62 .sub _main 
    63     .param pmc argv 
    64     .const int MAX = 500 
    65     .local int max 
    66     .local pmc kid 
    67     .local pmc Check_num 
    68     .local pmc stream 
    69     .local int argc 
    70     argc = argv 
    71     max = MAX 
    72     if argc < 2 goto no_arg 
    73       $S0 = argv[1] 
    74       max = $S0 
    75 no_arg: 
    76  
    77     #sweepoff 
    78 #       9  my $stream = new Thread::Queue; 
    79     stream = new 'TQueue' 
    80 #       10 my $kid    = new threads(\&check_num, $stream, 2); 
    81     Check_num = get_global "_check_num" 
    82     kid = new 'ParrotThread' 
    83     $P2 = new 'Integer' 
    84     $P2 = 2 
    85     kid.'run_clone'(Check_num, Check_num, stream, $P2) 
    86  
    87 #       12 for my $i ( 3 .. 1000 ) { 
    88     .local int i 
    89     i = 3 
    90 lp: 
    91 #       13     $stream->enqueue($i); 
    92     $P3 = new 'Integer' 
    93     $P3 = i 
    94     push stream, $P3 
    95     inc i 
    96     if i <= max goto lp 
    97 #       14 } 
    98  
    99 #       16 $stream->enqueue(undef); 
    100     $P4 = new 'Undef' 
    101     push stream, $P4 
    102  
    103 #       17 $kid->join; 
    104     kid.'join'() 
    105 .end 
    106  
    107 #       19 sub check_num { 
    108 #       20     my ($upstream, $cur_prime) = @_; 
    109 # XXX still no comments inside pcc param block 
    110 .sub _check_num 
    111    .param pmc sub 
    112    .param pmc upstream 
    113    .param pmc cur_prime 
    114  
    115 #       21     my $kid; 
    116     .local pmc kid 
    117     kid = new 'Undef' 
    118 #       22     my $downstream = new Thread::Queue; 
    119     .local pmc downstream 
    120     downstream = new 'TQueue' 
    121 #       23     while (my $num = $upstream->dequeue) { 
    122     .local pmc Num        # num is a reserved word 
    123 lp: 
    124     shift Num, upstream 
    125     $I0 = defined Num 
    126     unless $I0 goto ewhile 
    127 #       24         next unless $num % $cur_prime; 
    128     $P0 = new 'Integer' 
    129     $P0 = Num % cur_prime 
    130     unless $P0 goto lp 
    131 #       25         if ($kid) { 
    132     $I1 = defined kid 
    133     unless $I1 goto no_kid1 
    134 #       26            $downstream->enqueue($num); 
    135     push downstream, Num 
    136     goto lp 
    137 #       27                  } else { 
    138 no_kid1: 
    139 #       28            print "Found prime $num\n"; 
    140     print "Found prime " 
    141     print Num 
    142     print "\n" 
    143  
    144 #       29                $kid = new threads(\&check_num, $downstream, $num); 
    145     kid = new 'ParrotThread' 
    146     kid.'run_clone'(sub, sub, downstream, Num) 
    147     goto lp 
    148 #       31     } 
    149 ewhile: 
    150  
    151 #       32     $downstream->enqueue(undef) if $kid; 
    152     $I1 = defined kid 
    153     unless $I1 goto no_kid2 
    154  
    155     $P4 = new 'Undef' 
    156     push downstream, $P4 
    157  
    158 #       33     $kid->join           if $kid; 
    159     kid.'join'() 
    160  
    161 no_kid2: 
    162 #       34 } 
    163     # sleep 1   # turn on for watching memory usage 
    164 .end 
    165  
    166 # Local Variables: 
    167 #   mode: pir 
    168 #   fill-column: 100 
    169 # End: 
    170 # vim: expandtab shiftwidth=4 ft=pir: