cvsuser 04/01/14 09:00:53
Modified: . MANIFEST
t/pmc ref.t
Added: classes sharedref.pmc
Log:
parrot-threads-21
* forgot MANIFEST and to add sharedref.pmc
* update comment
Revision Changes Path
1.532 +1 -0 parrot/MANIFEST
Index: MANIFEST
===================================================================
RCS file: /cvs/public/parrot/MANIFEST,v
retrieving revision 1.531
retrieving revision 1.532
diff -u -w -r1.531 -r1.532
--- MANIFEST 8 Jan 2004 15:33:40 -0000 1.531
+++ MANIFEST 14 Jan 2004 17:00:35 -0000 1.532
@@ -69,6 +69,7 @@
classes/pmc2c.pl []
classes/pmc2c2.pl []
classes/pointer.pmc []
+classes/sharedref.pmc []
classes/random.pmc []
classes/ref.pmc []
classes/retcontinuation.pmc []
1.1 parrot/classes/sharedref.pmc
Index: sharedref.pmc
===================================================================
/* SharedRef.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
* $Id: sharedref.pmc,v 1.1 2004/01/14 17:00:45 leo Exp $
* Overview:
* The vtable functions for the SharedRef base class.
* This class wraps locking around PMC access.
* Data Structure and Algorithms:
* History:
* Initial revision by leo 2004.01.14
* Notes:
* All methods not present below get a default body autogenerated
* inside Pmc2c.pm.
*
* Currently all access is locked. When we have a non-copying GC
* allocator we can relax that a bit.
* References:
*/
#include "parrot/parrot.h"
#include "parrot/method_util.h"
/*
* TODO we should catch exceptions around these locks
* if the vtable meth throws the lock is never unlocked
*/
#define LOCK_PMC(interp, pmc) LOCK(pmc->synchronize->pmc_lock);
#define UNLOCK_PMC(interp, pmc) UNLOCK(pmc->synchronize->pmc_lock);
pmclass SharedRef does ref need_ext is_shared extends Ref {
void init () {
internal_exception(1, "SharedRef init without PMC\n");
}
void init_pmc(PMC* init) {
/*
* XXX if the PMC we refer to is an aggregate (or has properties)
* - call share() on the aggregate, which
* calls share() on its contents - so
* getting aggregate members only yields shared PMCs
* - and unshare the aggregate itself, because we
* lock on behalf of the referee
*
* A direct deref of the SharedRef is currently not enabled
* so we shouldn't leak unshared PMCs into different threads
*/
SUPER(init);
SELF->synchronize = mem_sys_allocate(sizeof(*SELF->synchronize));
SELF->synchronize->owner = INTERP;
MUTEX_INIT(SELF->synchronize->pmc_lock);
PObj_active_destroy_SET(SELF);
}
void init_pmc_props(PMC* init, PMC* props) {
SUPER(init, props);
}
void share () {
/* we do already sharing - so just ignore */
}
void mark () {
SUPER();
}
void destroy() {
PMC *ref = PMC_ptr2p(SELF);
if (PObj_active_destroy_TEST(ref))
VTABLE_destroy(INTERP, ref);
if (SELF->synchronize->owner != INTERP)
PANIC("SharedRef destroyed by wrong interpreter");
MUTEX_DESTROY(SELF->synchronize->pmc_lock);
mem_sys_free(SELF->synchronize);
}
}
1.3 +41 -1 parrot/t/pmc/ref.t
Index: ref.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/ref.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- ref.t 25 Dec 2003 21:49:02 -0000 1.2
+++ ref.t 14 Jan 2004 17:00:53 -0000 1.3
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 4;
+use Parrot::Test tests => 6;
use Test::More qw(skip);
output_is(<<'CODE', <<'OUTPUT', "new ref");
@@ -29,12 +29,16 @@
new P1, .Ref, P2
print "ok 1\n"
deref P3, P1
+ typeof S0, P1
+ print S0
+ print "\n"
typeof S0, P3
print S0
print "\n"
end
CODE
ok 1
+Ref
PerlInt
OUTPUT
@@ -57,4 +61,40 @@
1
1.500000
1.500000
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "typeof SharedRef");
+ new P2, .PerlInt
+ new P1, .SharedRef, P2
+ print "ok 1\n"
+ set P1, 4711
+ print P1
+ print "\n"
+ typeof S0, P1
+ print S0
+ print "\n"
+ set P1, "hello\n"
+ typeof S0, P1
+ print S0
+ print "\n"
+ print P1
+ end
+CODE
+ok 1
+4711
+PerlInt
+PerlString
+hello
+OUTPUT
+
+output_like(<<'CODE', <<'OUTPUT', "deref SharedRef");
+ new P2, .PerlInt
+ new P1, .SharedRef, P2
+ print "ok 1\n"
+ deref P3, P1
+ print "never\n"
+ end
+CODE
+/ok 1
+Not a reference PMC/
OUTPUT
