From 683929b49c6384fb92ba65fc111b71ae82a6e29d Mon Sep 17 00:00:00 2001 From: Malcolm Beattie Date: Mon, 22 Sep 1997 16:02:37 +0000 Subject: [PATCH] struct thread now stored in an SV and uses '~'-magic for access. p4raw-id: //depot/perlext/Thread@69 --- Thread.xs | 88 ++++++++++++++++++++++++++++++++++----------------------------- typemap | 27 ++++++++++---------- 2 files changed, 60 insertions(+), 55 deletions(-) diff --git a/Thread.xs b/Thread.xs index ab06922..4344439 100644 --- a/Thread.xs +++ b/Thread.xs @@ -2,6 +2,8 @@ #include "perl.h" #include "XSUB.h" +static I32 threadnum = 0; + static void * threadstart(arg) void *arg; @@ -15,8 +17,8 @@ void *arg; AV *returnav = newAV(); int i; - DEBUG_L(PerlIO_printf(PerlIO_stderr(), "new thread 0x%lx starting at %s\n", - (unsigned long) thr, SvPEEK(TOPs))); + DEBUG_L(PerlIO_printf(PerlIO_stderr(), "new thread %p starting at %s\n", + thr, SvPEEK(TOPs))); thr = (Thread) arg; savemark = TOPMARK; thr->prev = thr->prev_run = savethread; @@ -78,8 +80,8 @@ void *arg; croak("panic: pthread_setspecific"); /* Only now can we use SvPEEK (which calls sv_newmortal which does dTHR) */ - DEBUG_L(PerlIO_printf(PerlIO_stderr(), "new thread 0x%lx starting at %s\n", - (unsigned long) thr, SvPEEK(TOPs))); + DEBUG_L(PerlIO_printf(PerlIO_stderr(), "new thread %p starting at %s\n", + thr, SvPEEK(TOPs))); JMPENV_PUSH(ret); switch (ret) { @@ -132,11 +134,11 @@ void *arg; Safefree(cxstack); Safefree(tmps_stack); - if (ThrSTATE(thr) == THR_DETACHED) { + if (ThrSTATE(thr) == THRf_DETACHED) { DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p detached...zapping returnav\n", thr)); SvREFCNT_dec(returnav); - ThrSETSTATE(thr, THR_DEAD); + ThrSETSTATE(thr, THRf_DEAD); } DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p returning\n", thr)); return (void *) returnav; /* Available for anyone to join with us */ @@ -145,18 +147,24 @@ void *arg; #endif } -Thread -newthread(startsv, initargs) +static SV * +newthread(startsv, initargs, class) SV *startsv; AV *initargs; +char *class; { dTHR; dSP; Thread savethread; int i; + SV *sv; savethread = thr; - New(53, thr, 1, struct thread); + sv = newSVpv("", 0); + SvGROW(sv, sizeof(struct thread) + 1); + SvCUR_set(sv, sizeof(struct thread)); + thr = (Thread) SvPVX(sv); + oursv = sv; /* If we don't zero these foostack pointers, init_stacks won't init them */ markstack = 0; scopestack = 0; @@ -170,7 +178,8 @@ AV *initargs; /* top_env? */ /* runlevel */ cvcache = newHV(); - ThrSETSTATE(thr, THR_NORMAL); + thrflags = 0; + ThrSETSTATE(thr, THRf_NORMAL); /* The following pushes the arg list and startsv onto the *new* stack */ PUSHMARK(sp); @@ -199,20 +208,20 @@ AV *initargs; /* Go */ MUTEX_UNLOCK(threadstart_mutexp); #endif - return thr; + sv = newSViv(++threadnum); + sv_magic(sv, oursv, '~', 0, 0); + return sv_bless(newRV(sv), gv_stashpv(class, TRUE)); } MODULE = Thread PACKAGE = Thread -Thread +void new(class, startsv, ...) - SV * class + char * class SV * startsv AV * av = av_make(items - 2, &ST(2)); - CODE: - RETVAL = newthread(startsv, av); - OUTPUT: - RETVAL + PPCODE: + XPUSHs(sv_2mortal(newthread(startsv, av, class))); void join(t) @@ -221,19 +230,18 @@ join(t) int i = NO_INIT PPCODE: DEBUG_L(PerlIO_printf(PerlIO_stderr(), - "0x%lx: joining 0x%lx (state 0x%lx)\n", - (unsigned long)thr, (unsigned long)t, - (unsigned long)ThrSTATE(t));); - if (ThrSTATE(t) == THR_DETACHED) + "%p: joining %p (state 0x%lx)\n", + thr, t, (unsigned long)ThrSTATE(t));); + if (ThrSTATE(t) == THRf_DETACHED) croak("tried to join a detached thread"); - else if (ThrSTATE(t) == THR_JOINED) + else if (ThrSTATE(t) == THRf_JOINED) croak("tried to rejoin an already joined thread"); - else if (ThrSTATE(t) == THR_DEAD) + else if (ThrSTATE(t) == THRf_DEAD) croak("tried to join a dead thread"); if (pthread_join(t->Tself, (void **) &av)) croak("pthread_join failed"); - ThrSETSTATE(t, THR_JOINED); + ThrSETSTATE(t, THRf_JOINED); /* Could easily speed up the following if necessary */ for (i = 0; i <= AvFILL(av); i++) XPUSHs(sv_2mortal(*av_fetch(av, i, FALSE))); @@ -243,27 +251,27 @@ detach(t) Thread t CODE: DEBUG_L(PerlIO_printf(PerlIO_stderr(), - "0x%lx: detaching 0x%lx (state 0x%lx)\n", - (unsigned long)thr, (unsigned long)t, - (unsigned long)ThrSTATE(t));); - if (ThrSTATE(t) == THR_DETACHED) + "%p: detaching %p (state 0x%lx)\n", + thr, t, (unsigned long)ThrSTATE(t));); + if (ThrSTATE(t) == THRf_DETACHED) croak("tried to detach an already detached thread"); - else if (ThrSTATE(t) == THR_JOINED) + else if (ThrSTATE(t) == THRf_JOINED) croak("tried to detach an already joined thread"); - else if (ThrSTATE(t) == THR_DEAD) + else if (ThrSTATE(t) == THRf_DEAD) croak("tried to detach a dead thread"); if (pthread_detach(t->Tself)) - croak("pthread_detach failed"); - ThrSETSTATE(t, THR_DETACHED); + croak("panic: pthread_detach failed"); + ThrSETSTATE(t, THRf_DETACHED); void DESTROY(t) Thread t CODE: - if (ThrSTATE(t) == THR_NORMAL) { + if (ThrSTATE(t) == THRf_NORMAL) { if (pthread_detach(t->Tself)) - croak("pthread_detach failed"); - ThrSETSTATE(t, THR_DETACHED); + croak("panic: pthread_detach failed"); + ThrSETSTATE(t, THRf_DETACHED); + thrflags |= THRf_DIE_FATAL; } void @@ -286,8 +294,7 @@ CODE: sv = SvRV(sv); mg = condpair_magic(sv); - DEBUG_L(PerlIO_printf(PerlIO_stderr(), "0x%lx: cond_wait 0x%lx\n", - (unsigned long)thr, (unsigned long)sv)); + DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: cond_wait %p\n", thr, sv)); MUTEX_LOCK(MgMUTEXP(mg)); if (MgOWNER(mg) != thr) { MUTEX_UNLOCK(MgMUTEXP(mg)); @@ -311,8 +318,7 @@ CODE: sv = SvRV(sv); } mg = condpair_magic(sv); - DEBUG_L(PerlIO_printf(PerlIO_stderr(), "0x%lx: cond_signal 0x%lx\n", - (unsigned long)thr, (unsigned long)sv)); + DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: cond_signal %p\n",thr,sv)); MUTEX_LOCK(MgMUTEXP(mg)); if (MgOWNER(mg) != thr) { MUTEX_UNLOCK(MgMUTEXP(mg)); @@ -330,8 +336,8 @@ CODE: sv = SvRV(sv); mg = condpair_magic(sv); - DEBUG_L(PerlIO_printf(PerlIO_stderr(), "0x%lx: cond_broadcast 0x%lx\n", - (unsigned long)thr, (unsigned long)sv)); + DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: cond_broadcast %p\n", + thr, sv)); MUTEX_LOCK(MgMUTEXP(mg)); if (MgOWNER(mg) != thr) { MUTEX_UNLOCK(MgMUTEXP(mg)); diff --git a/typemap b/typemap index 6ef6036..a9a5bd8 100644 --- a/typemap +++ b/typemap @@ -1,23 +1,22 @@ -Thread T_IVOBJ +Thread T_XSOBJ INPUT -T_IVOBJ - if (sv_isobject($arg)) { - $var = ($type) SvIV((SV*)SvRV($arg)); +T_XSOBJ + STMT_START { + MAGIC *mg; + SV *sv = ($arg); + + if (!sv_isobject(sv)) + croak(\"$var is not an object\"); + if (!SvRMAGICAL(sv) || !(mg = mg_find(sv, '~'))) + croak(\"$arg is a counterfeit ${ntype} object\"); + $var = ($type) SvPVX(mg->mg_obj); DEBUG_L(PerlIO_printf(PerlIO_stderr(), - \"XSUB ${func_name}: 0x%lx\\n\", - (unsigned long)$var);); - } - else - croak(\"$var is not an object\") + \"XSUB ${func_name}: %p\\n\", $var);) + } STMT_END T_IVREF if (SvROK($arg)) $var = ($type) SvIV((SV*)SvRV($arg)); else croak(\"$var is not a reference\") -OUTPUT -T_IVOBJ - sv_setref_iv($arg, \"${ntype}\", (IV)($var)); - DEBUG_L(PerlIO_printf(PerlIO_stderr(), \"XSUB $func_name: 0x%lx\\n\", - (unsigned long)$var);); -- 2.7.4