Revision history for Perl extension threads.
+1.18 Fri Mar 24 14:21:36 EST 2006
+ - ->equal returns 0 on false for backwards compatibility
+ - Changed UVs to IVs in XS code (except for TID)
+ - Use ->create in tests
+
1.17 Thu Mar 23 10:31:20 EST 2006
- Restoration of 'core' build parameters
-threads version 1.17
+threads version 1.18
====================
This module needs perl 5.8.0 or later compiled with 'useithreads'.
use strict;
use warnings;
-#
-# The reason this does not use a Test module is that
-# they mess up test numbers between threads
-#
-# And even when that will be fixed, this is a basic
-# test and should not rely on shared variables
-#
-# This will test the basic API, it will not use any coderefs
-# as they are more advanced
-#
-#########################
-
-
BEGIN {
if ($ENV{'PERL_CORE'}){
chdir 't';
use ExtUtils::testlib;
-BEGIN { $| = 1; print "1..28\n" };
+BEGIN { $| = 1; print "1..30\n" };
use threads;
ok(20, $thr1 != $thr2, 'Treads not equal');
ok(21, $thr1 == $thr3, 'Threads equal');
-ok(22, threads->object($thr1->tid())->tid() == 11, 'Object method');
-ok(23, threads->object($thr2->tid())->tid() == 12, 'Object method');
+ok(22, $thr1->_handle(), 'Handle method');
+ok(23, $thr2->_handle(), 'Handle method');
+
+ok(24, threads->object($thr1->tid())->tid() == 11, 'Object method');
+ok(25, threads->object($thr2->tid())->tid() == 12, 'Object method');
$thr1->join();
$thr2->join();
-my $sub = sub { ok(24, shift() == 1, "Test code ref"); };
+my $sub = sub { ok(26, shift() == 1, "Test code ref"); };
threads->create($sub, 1)->join();
my $thrx = threads->object(99);
-ok(25, ! defined($thrx), 'No object');
+ok(27, ! defined($thrx), 'No object');
$thrx = threads->object();
-ok(26, ! defined($thrx), 'No object');
+ok(28, ! defined($thrx), 'No object');
$thrx = threads->object(undef);
-ok(27, ! defined($thrx), 'No object');
+ok(29, ! defined($thrx), 'No object');
$thrx = threads->object(0);
-ok(28, ! defined($thrx), 'No object');
+ok(30, ! defined($thrx), 'No object');
# EOF
if ($^O eq 'linux') {
# First modify $0 in a subthread.
print "# mainthread: \$0 = $0\n";
- threads->new( sub {
+ threads->create( sub {
print "# subthread: \$0 = $0\n";
$0 = "foobar";
print "# subthread: \$0 = $0\n" } )->join;
}
{
- my $t = threads->new(sub {});
+ my $t = threads->create(sub {});
$t->join;
- my $x = threads->new(sub {});
+ my $x = threads->create(sub {});
$x->join;
eval {
$t->join;
# archives for the thread "maint@20974 or before broke mp2 ithreads test".
use IO::File;
# this coredumped between #20930 and #21000
- $_->join for map threads->new(sub{ok($_, "stress newCONSTSUB")}), 1..2;
+ $_->join for map threads->create(sub{ok($_, "stress newCONSTSUB")}), 1..2;
}
-BEGIN { $| = 1; print "1..8\n" };
+BEGIN { $| = 1; print "1..15\n" };
use threads;
return $ok;
}
-ok(2, scalar @{[threads->list]} == 0,'');
-
+### Start of Testing ###
+ok(2, scalar @{[threads->list()]} == 0, 'No threads yet');
threads->create(sub {})->join();
-ok(3, scalar @{[threads->list]} == 0,'');
+ok(3, scalar @{[threads->list()]} == 0, 'Empty thread list after join');
my $thread = threads->create(sub {});
-ok(4, scalar @{[threads->list]} == 1,'');
+ok(4, scalar(threads->list()) == 1, 'Non-empty thread list');
+ok(5, threads->list() == 1, 'Non-empty thread list');
$thread->join();
-ok(5, scalar @{[threads->list]} == 0,'');
+ok(6, scalar @{[threads->list()]} == 0, 'Thread list empty again');
+ok(7, threads->list() == 0, 'Thread list empty again');
+
+$thread = threads->create(sub {
+ ok(8, threads->list() == 1, 'Non-empty thread list in thread');
+ ok(9, threads->self == (threads->list())[0], 'Self in thread list')
+});
-$thread = threads->create(sub { ok(6, threads->self == (threads->list)[0],'')});
threads->yield; # help out non-preemptive thread implementations
sleep 1;
-ok(7, $thread == (threads->list)[0],'');
+
+ok(10, scalar(threads->list()) == 1, 'Thread count 1');
+ok(11, threads->list() == 1, 'Thread count 1');
+my $cnt = threads->list();
+ok(12, $cnt == 1, 'Thread count 1');
+my ($thr_x) = threads->list();
+ok(13, $thread == $thr_x, 'Thread in list');
$thread->join();
-ok(8, scalar @{[threads->list]} == 0,'');
+ok(14, scalar @{[threads->list()]} == 0, 'Thread list empty');
+ok(15, threads->list() == 0, 'Thread list empty');
+
+# EOF
#########################
if ($] == 5.008 || $] >= 5.008003) {
- threads->new( sub {1} )->join;
+ threads->create( sub {1} )->join;
my $not = eval { Config::myconfig() } ? '' : 'not ';
print "${not}ok $test - Are we able to call Config::myconfig after clone\n";
} else {
our $unique_scalar : unique;
our @unique_array : unique;
our %unique_hash : unique;
-threads->new(
+threads->create(
sub {
my $TODO = ":unique needs to be re-implemented in a non-broken way";
eval { $unique_scalar = 1 };
# sub { $x."bar" };
# }
#
-# my $string = threads->new(\&f)->join->();
+# my $string = threads->create(\&f)->join->();
# print $string eq 'foobar' ? '' : 'not ', "ok $test - returning closure\n";
# $test++;
my %h = (1,2,3,4);
is (keys %h, 2, "keys correct in parent");
-my $child = threads->new(sub { return scalar keys %h })->join;
+my $child = threads->create(sub { return scalar keys %h })->join;
is ($child, 2, "keys correct in child");
lock_keys (%h);
is (keys %h, 1, "keys correct in parent with restricted hash");
-$child = threads->new(sub { return scalar keys %h })->join;
+$child = threads->create(sub { return scalar keys %h })->join;
is ($child, 1, "keys correct in child with restricted hash");
1;
return shift;
}
{
- my $t = threads->new(\&content, "ok 2\n", "ok 3\n", 1..1000);
+ my $t = threads->create(\&content, "ok 2\n", "ok 3\n", 1..1000);
print $t->join();
}
{
my $t;
{
lock($lock);
- $t = threads->new(sub { lock($lock); print "ok 5\n"});
+ $t = threads->create(sub { lock($lock); print "ok 5\n"});
print "ok 4\n";
}
$t->join();
my $ret;
print $val;
if(@_) {
- $ret = threads->new(\&dorecurse, @_);
+ $ret = threads->create(\&dorecurse, @_);
$ret->join;
}
}
{
- my $t = threads->new(\&dorecurse, map { "ok $_\n" } 6..10);
+ my $t = threads->create(\&dorecurse, map { "ok $_\n" } 6..10);
$t->join();
}
{
# test that sleep lets other thread run
- my $t = threads->new(\&dorecurse, "ok 11\n");
+ my $t = threads->create(\&dorecurse, "ok 11\n");
threads->yield; # help out non-preemptive thread implementations
sleep 1;
print "ok 12\n";
my $ret;
print $val;
if (@_) {
- $ret = threads->new(\&islocked, shift);
+ $ret = threads->create(\&islocked, shift);
}
return $ret;
}
-my $t = threads->new(\&islocked, "ok 13\n", "ok 14\n");
+my $t = threads->create(\&islocked, "ok 13\n", "ok 14\n");
$t->join->join;
}
{
curr_test(15);
- my $thr1 = threads->new(\&testsprintf, 15);
- my $thr2 = threads->new(\&testsprintf, 16);
+ my $thr1 = threads->create(\&testsprintf, 15);
+ my $thr2 = threads->create(\&testsprintf, 16);
my $short = "This is a long string that goes on and on.";
my $shorte = " a long string that goes on and on.";
# since it tests rand
my %rand : shared;
rand(10);
- threads->new( sub { $rand{int(rand(10000000000))}++ } ) foreach 1..25;
+ threads->create( sub { $rand{int(rand(10000000000))}++ } ) foreach 1..25;
$_->join foreach threads->list;
# use Data::Dumper qw(Dumper);
# print Dumper(\%rand);
# bugid #24165
run_perl(prog =>
- 'use threads; sub a{threads->new(shift)} $t = a sub{}; $t->tid; $t->join; $t->tid');
+ 'use threads; sub a{threads->create(shift)} $t = a sub{}; $t->tid; $t->join; $t->tid');
is($?, 0, 'coredump in global destruction');
# test CLONE_SKIP() functionality
$cloned .= "$_" =~ /ARRAY/ ? '1' : '0' for @objs;
is($cloned, ($depth ? '00010001111' : '11111111111'),
"objs clone skip at depth $depth");
- threads->new( \&f, $depth+1)->join if $depth < 2;
+ threads->create( \&f, $depth+1)->join if $depth < 2;
@objs = ();
}
f(0);
if($threads::shared::threads_shared);
}
-our $VERSION = '1.17';
+our $VERSION = '1.18';
# Load the XS code
### Methods, etc. ###
-# || 0 to ensure compatibility with previous versions
-sub equal { ($_[0]->tid == $_[1]->tid) || 0 }
-
# use "goto" trick to avoid pad problems from 5.8.1 (fixed in 5.8.2)
# should also be faster
sub async (&;@) { unshift @_,'threads'; goto &new }
-sub object {
- return undef unless @_ > 1;
- foreach (threads->list) {
- return $_ if $_->tid == $_[1];
- }
- return undef;
-}
-
$threads::threads = 1;
-# why document 'new' then use 'create' in the tests!
-*create = \&new;
+# 'new' is an alias for 'create'
+*new = \&create;
1;
=head1 VERSION
-This document describes threads version 1.17
+This document describes threads version 1.18
=head1 SYNOPSIS
You may do C<use threads qw(yield)> then use just a bare C<yield> in your
code.
-=item threads->list();
+=item threads->list()
-This will return a list of all non joined, non detached threads.
+In a list context, returns a list of all non-joined, non-detached I<threads>
+objects. In a scalar context, returns a count of the same.
=item $thr1->equal($thr2)
semi-colon after the closing brace. Like C<< threads->new >>, C<async>
returns a thread object.
+=item $thr->_handle()
+
+This I<private> method returns the memory location of the internal thread
+structure associated with a threads object. For Win32, this is the handle
+returned by C<CreateThread>; for other platforms, it is the pointer returned
+by C<pthread_create>.
+
+This method is of no use for general Perl threads programming. Its intent is
+to provide other (XS-based) thread modules with the capability to access, and
+possibly manipulate, the underlying thread structure associated with a Perl
+thread.
+
+=item threads->_handle()
+
+Class method that allows a thread to obtain its own I<handle>.
+
=back
=head1 WARNINGS
On some platforms it might not be possible to destroy "parent"
threads while there are still existing child "threads".
-=item tid is I32
-
-The thread id is a 32 bit integer, it can potentially overflow.
-This might be fixed in a later version of perl.
-
=item Creating threads inside BEGIN blocks
Creating threads inside BEGIN blocks (or during the compilation phase
L<http://www.cpanforum.com/dist/threads>
Annotated POD for L<threads>:
-L<http://annocpan.org/~JDHEDDEN/threads-1.17/shared.pm>
+L<http://annocpan.org/~JDHEDDEN/threads-1.18/shared.pm>
L<threads::shared>, L<perlthrtut>
struct ithread_s *next; /* Next thread in the list */
struct ithread_s *prev; /* Prev thread in the list */
PerlInterpreter *interp; /* The threads interpreter */
- I32 tid; /* Threads module's thread id */
+ UV tid; /* Threads module's thread id */
perl_mutex mutex; /* Mutex for updating things in this struct */
- I32 count; /* How many SVs have a reference to us */
+ IV count; /* How many SVs have a reference to us */
signed char state; /* Are we detached ? */
int gimme; /* Context of create */
SV* init_function; /* Code to run */
START_MY_CXT
-ithread *threads;
-
-/* Macros to supply the aTHX_ in an embed.h like manner */
-#define ithread_join(thread) Perl_ithread_join(aTHX_ thread)
-#define ithread_DESTROY(thread) Perl_ithread_DESTROY(aTHX_ thread)
-#define ithread_CLONE(thread) Perl_ithread_CLONE(aTHX_ thread)
-#define ithread_detach(thread) Perl_ithread_detach(aTHX_ thread)
-#define ithread_tid(thread) ((thread)->tid)
-#define ithread_yield(thread) (YIELD);
+static ithread *threads;
static perl_mutex create_destruct_mutex; /* protects the creation and destruction of threads*/
-I32 tid_counter = 0;
-I32 known_threads = 0;
-I32 active_threads = 0;
+static UV tid_counter = 0;
+static IV known_threads = 0;
+static IV active_threads = 0;
-void Perl_ithread_set (pTHX_ ithread* thread)
+static void
+Perl_ithread_set (pTHX_ ithread* thread)
{
dMY_CXT;
MY_CXT.thread = thread;
}
-ithread* Perl_ithread_get (pTHX) {
+static ithread*
+Perl_ithread_get (pTHX) {
dMY_CXT;
return MY_CXT.thread;
}
if (aTHX == PL_curinterp && active_threads != 1) {
if (ckWARN_d(WARN_THREADS))
Perl_warn(aTHX_ "A thread exited while %" IVdf " threads were running",
- (IV)active_threads);
+ active_threads);
veto_cleanup = 1;
}
MUTEX_UNLOCK(&create_destruct_mutex);
*/
#ifdef WIN32
-THREAD_RET_TYPE
+static THREAD_RET_TYPE
Perl_ithread_run(LPVOID arg) {
#else
-void*
+static void*
Perl_ithread_run(void * arg) {
#endif
ithread* thread = (ithread*) arg;
{
AV* params = (AV*) SvRV(thread->params);
- I32 len = av_len(params)+1;
- int i;
+ int len = (int)av_len(params)+1;
+ int ii;
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
- for(i = 0; i < len; i++) {
+ for(ii = 0; ii < len; ii++) {
XPUSHs(av_shift(params));
}
PUTBACK;
- len = call_sv(thread->init_function, thread->gimme|G_EVAL);
+ len = (int)call_sv(thread->init_function, thread->gimme|G_EVAL);
SPAGAIN;
- for (i=len-1; i >= 0; i--) {
+ for (ii=len-1; ii >= 0; ii--) {
SV *sv = POPs;
- av_store(params, i, SvREFCNT_inc(sv));
+ av_store(params, ii, SvREFCNT_inc(sv));
}
if (SvTRUE(ERRSV) && ckWARN_d(WARN_THREADS)) {
Perl_warn(aTHX_ "thread failed to start: %" SVf, ERRSV);
#endif
}
-SV *
+static SV *
ithread_to_SV(pTHX_ SV *obj, ithread *thread, char *classname, bool inc)
{
SV *sv;
return obj;
}
-ithread *
+static ithread *
SV_to_ithread(pTHX_ SV *sv)
{
if (SvROK(sv))
* Called in context of parent thread
*/
-SV *
+static SV *
Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* params)
{
ithread* thread;
ithread* current_thread = Perl_ithread_get(aTHX);
SV** tmps_tmp = PL_tmps_stack;
- I32 tmps_ix = PL_tmps_ix;
+ IV tmps_ix = PL_tmps_ix;
#ifndef WIN32
int failure;
const char* panic = NULL;
return ithread_to_SV(aTHX_ obj, thread, classname, FALSE);
}
-SV*
+static SV*
Perl_ithread_self (pTHX_ SV *obj, char* Class)
{
ithread *thread = Perl_ithread_get(aTHX);
return NULL; /* silence compiler warning */
}
-/*
- * Joins the thread this code needs to take the returnvalue from the
- * call_sv and send it back
- */
-void
-Perl_ithread_CLONE(pTHX_ SV *obj)
-{
- if (SvROK(obj)) {
- ithread *thread = SV_to_ithread(aTHX_ obj);
- }
- else if (ckWARN_d(WARN_THREADS)) {
- Perl_warn(aTHX_ "CLONE %" SVf,obj);
- }
-}
-
-AV*
+/* Joins the thread.
+ * This code takes the return value from the call_sv and sends it back.
+ */
+static AV*
Perl_ithread_join(pTHX_ SV *obj)
{
ithread *thread = SV_to_ithread(aTHX_ obj);
return (AV*)NULL;
}
-void
+static void
Perl_ithread_DESTROY(pTHX_ SV *sv)
{
ithread *thread = SV_to_ithread(aTHX_ sv);
#ifdef USE_ITHREADS
void
-ithread_new (classname, function_to_call, ...)
-char * classname
-SV * function_to_call
-CODE:
-{
- AV* params = newAV();
- if (items > 2) {
- int i;
- for(i = 2; i < items ; i++) {
- av_push(params, SvREFCNT_inc(ST(i)));
- }
- }
- ST(0) = sv_2mortal(Perl_ithread_create(aTHX_ Nullsv, classname, function_to_call, newRV_noinc((SV*) params)));
- XSRETURN(1);
-}
+ithread_create(...)
+ PREINIT:
+ char *classname;
+ SV *function_to_call;
+ AV *params;
+ int ii;
+ CODE:
+ if (items < 2)
+ Perl_croak(aTHX_ "Usage: threads->create(function, ...)");
+
+ classname = (char *)SvPV_nolen(ST(0));
+ function_to_call = ST(1);
+
+ /* Function args */
+ params = newAV();
+ if (items > 2) {
+ for (ii=2; ii < items; ii++) {
+ av_push(params, SvREFCNT_inc(ST(ii)));
+ }
+ }
+
+ /* Create thread */
+ ST(0) = sv_2mortal(Perl_ithread_create(aTHX_ Nullsv,
+ classname,
+ function_to_call,
+ newRV_noinc((SV*)params)));
+ /* XSRETURN(1); - implied */
+
void
-ithread_list(char *classname)
-PPCODE:
-{
- ithread *curr_thread;
- MUTEX_LOCK(&create_destruct_mutex);
- curr_thread = threads;
- if(curr_thread->tid != 0)
- XPUSHs( sv_2mortal(ithread_to_SV(aTHX_ NULL, curr_thread, classname, TRUE)));
- while(curr_thread) {
- curr_thread = curr_thread->next;
- if(curr_thread == threads)
- break;
- if(curr_thread->state & PERL_ITHR_DETACHED ||
- curr_thread->state & PERL_ITHR_JOINED)
- continue;
- XPUSHs( sv_2mortal(ithread_to_SV(aTHX_ NULL, curr_thread, classname, TRUE)));
- }
- MUTEX_UNLOCK(&create_destruct_mutex);
-}
+ithread_list(...)
+ PREINIT:
+ char *classname;
+ ithread *thr;
+ int list_context;
+ IV count = 0;
+ PPCODE:
+ /* Class method only */
+ if (SvROK(ST(0)))
+ Perl_croak(aTHX_ "Usage: threads->list()");
+ classname = (char *)SvPV_nolen(ST(0));
+
+ /* Calling context */
+ list_context = (GIMME_V == G_ARRAY);
+
+ /* Walk through threads list */
+ MUTEX_LOCK(&create_destruct_mutex);
+ for (thr = threads->next;
+ thr != threads;
+ thr = thr->next)
+ {
+ /* Ignore detached or joined threads */
+ if (thr->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED)) {
+ continue;
+ }
+ /* Push object on stack if list context */
+ if (list_context) {
+ XPUSHs(sv_2mortal(ithread_to_SV(aTHX_ NULL, thr, classname, TRUE)));
+ }
+ count++;
+ }
+ MUTEX_UNLOCK(&create_destruct_mutex);
+ /* If scalar context, send back count */
+ if (! list_context) {
+ XSRETURN_IV(count);
+ }
void
-ithread_self(char *classname)
-CODE:
-{
- ST(0) = sv_2mortal(Perl_ithread_self(aTHX_ Nullsv,classname));
- XSRETURN(1);
-}
+ithread_self(...)
+ PREINIT:
+ char *classname;
+ CODE:
+ /* Class method only */
+ if (SvROK(ST(0)))
+ Perl_croak(aTHX_ "Usage: threads->self()");
+ classname = (char *)SvPV_nolen(ST(0));
+
+ ST(0) = sv_2mortal(Perl_ithread_self(aTHX_ Nullsv, classname));
+ /* XSRETURN(1); - implied */
-int
-ithread_tid(ithread *thread)
void
-ithread_join(SV *obj)
-PPCODE:
-{
- AV* params = Perl_ithread_join(aTHX_ obj);
- int i;
- I32 len = AvFILL(params);
- for (i = 0; i <= len; i++) {
- SV* tmp = av_shift(params);
- XPUSHs(tmp);
- sv_2mortal(tmp);
- }
- SvREFCNT_dec(params);
-}
+ithread_tid(...)
+ PREINIT:
+ ithread *thread;
+ CODE:
+ thread = SV_to_ithread(aTHX_ ST(0));
+ XST_mUV(0, thread->tid);
+ /* XSRETURN(1); - implied */
+
void
-yield(...)
-CODE:
-{
- YIELD;
-}
-
+ithread_join(...)
+ PREINIT:
+ AV *params;
+ int len;
+ int ii;
+ PPCODE:
+ /* Object method only */
+ if (! sv_isobject(ST(0)))
+ Perl_croak(aTHX_ "Usage: $thr->join()");
+
+ /* Join thread and get return values */
+ params = Perl_ithread_join(aTHX_ ST(0));
+ if (! params) {
+ XSRETURN_UNDEF;
+ }
+
+ /* Put return values on stack */
+ len = (int)AvFILL(params);
+ for (ii=0; ii <= len; ii++) {
+ SV* param = av_shift(params);
+ XPUSHs(sv_2mortal(param));
+ }
+
+ /* Free return value array */
+ SvREFCNT_dec(params);
+
+
+void
+ithread_yield(...)
+ CODE:
+ YIELD;
+
+
+void
+ithread_detach(...)
+ PREINIT:
+ ithread *thread;
+ CODE:
+ thread = SV_to_ithread(aTHX_ ST(0));
+ Perl_ithread_detach(aTHX_ thread);
+
void
-ithread_detach(ithread *thread)
+ithread_DESTROY(...)
+ CODE:
+ Perl_ithread_DESTROY(aTHX_ ST(0));
+
+
+void
+ithread_equal(...)
+ CODE:
+ /* Compares TIDs to determine thread equality.
+ * Return 0 on false for backward compatibility.
+ */
+ if (sv_isobject(ST(0)) && sv_isobject(ST(1))) {
+ ithread *thr1 = INT2PTR(ithread *, SvIV(SvRV(ST(0))));
+ ithread *thr2 = INT2PTR(ithread *, SvIV(SvRV(ST(1))));
+ if (thr1->tid == thr2->tid) {
+ XST_mYES(0);
+ } else {
+ XST_mIV(0, 0);
+ }
+ } else {
+ XST_mIV(0, 0);
+ }
+ /* XSRETURN(1); - implied */
+
void
-ithread_DESTROY(SV *thread)
+ithread_object(...)
+ PREINIT:
+ char *classname;
+ UV tid;
+ ithread *thr;
+ int found = 0;
+ CODE:
+ /* Class method only */
+ if (SvROK(ST(0)))
+ Perl_croak(aTHX_ "Usage: threads->object($tid)");
+ classname = (char *)SvPV_nolen(ST(0));
+
+ if ((items < 2) || ! SvOK(ST(1))) {
+ XSRETURN_UNDEF;
+ }
+
+ tid = SvUV(ST(1));
+
+ /* Walk through threads list */
+ MUTEX_LOCK(&create_destruct_mutex);
+ for (thr = threads->next;
+ thr != threads;
+ thr = thr->next)
+ {
+ /* Look for TID, but ignore detached or joined threads */
+ if ((thr->tid != tid) ||
+ (thr->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED)))
+ {
+ continue;
+ }
+ /* Put object on stack */
+ ST(0) = sv_2mortal(ithread_to_SV(aTHX_ NULL, thr, classname, TRUE));
+ found = 1;
+ break;
+ }
+ MUTEX_UNLOCK(&create_destruct_mutex);
+ if (! found) {
+ XSRETURN_UNDEF;
+ }
+ /* XSRETURN(1); - implied */
+
+
+void
+ithread__handle(...);
+ PREINIT:
+ ithread *thread;
+ CODE:
+ thread = SV_to_ithread(aTHX_ ST(0));
+#ifdef WIN32
+ XST_mUV(0, PTR2UV(thread->handle));
+#else
+ XST_mUV(0, PTR2UV(thread->thr));
+#endif
+ /* XSRETURN(1); - implied */
#endif /* USE_ITHREADS */
projects / platform / upstream / perl.git / commitdiff