From: Malcolm Beattie <mbeattie@sable.ox.ac.uk>
Date: Mon, 22 Sep 1997 16:02:37 +0000 (+0000)
Subject: struct thread now stored in an SV and uses '~'-magic for access.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=683929b49c6384fb92ba65fc111b71ae82a6e29d;p=p5sagit%2Fp5-mst-13.2.git

struct thread now stored in an SV and uses '~'-magic for access.

p4raw-id: //depot/perlext/Thread@69
---

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););