From: Nick Ing-Simmons <nik@tiuk.ti.com>
Date: Sat, 25 Apr 1998 15:16:54 +0000 (+0000)
Subject: Implement use attrs qw(locked package);
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=74efa5a2169712a879c65f86ca8d53d55975e1a2;p=p5sagit%2Fp5-mst-13.2.git

Implement use attrs qw(locked package);
Passes all tests except posix (hangs/dies) in sigaction test after
printing "ok 9".

p4raw-id: //depot/ansiperl@901
---

diff --git a/cv.h b/cv.h
index 0eeedfd..b768f63 100644
--- a/cv.h
+++ b/cv.h
@@ -61,7 +61,8 @@ struct xpvcv {
 #define CVf_NODEBUG	0x0020	/* no DB::sub indirection for this CV
 				   (esp. useful for special XSUBs) */
 #define CVf_METHOD	0x0040	/* CV is explicitly marked as a method */
-#define CVf_LOCKED	0x0080	/* CV locks itself or first arg on entry */
+#define CVf_LOCKED	0x0080	/* CV locks itself, package or first arg on entry */
+#define CVf_PACKAGE	0x0100	/* CV locks package on entry */
 
 #define CvCLONE(cv)		(CvFLAGS(cv) & CVf_CLONE)
 #define CvCLONE_on(cv)		(CvFLAGS(cv) |= CVf_CLONE)
@@ -94,3 +95,8 @@ struct xpvcv {
 #define CvLOCKED(cv)		(CvFLAGS(cv) & CVf_LOCKED)
 #define CvLOCKED_on(cv)		(CvFLAGS(cv) |= CVf_LOCKED)
 #define CvLOCKED_off(cv)	(CvFLAGS(cv) &= ~CVf_LOCKED)
+
+#define CvPACKAGE(cv)		(CvFLAGS(cv) & CVf_PACKAGE)
+#define CvPACKAGE_on(cv)	(CvFLAGS(cv) |= CVf_PACKAGE)
+#define CvPACKAGE_off(cv)	(CvFLAGS(cv) &= ~CVf_PACKAGE)
+
diff --git a/ext/attrs/attrs.pm b/ext/attrs/attrs.pm
index fe2bf35..01a0de3 100644
--- a/ext/attrs/attrs.pm
+++ b/ext/attrs/attrs.pm
@@ -34,17 +34,27 @@ Valid attributes are as follows.
 
 Indicates that the invoking subroutine is a method.
 
+=item package
+
+If the subroutine is locked, lock the package in which it is
+defined.
+
 =item locked
 
 Setting this attribute is only meaningful when the subroutine or
-method is to be called by multiple threads. When set on a method
-subroutine (i.e. one marked with the B<method> attribute above),
-perl ensures that any invocation of it implicitly locks its first
-argument before execution. When set on a non-method subroutine,
-perl ensures that a lock is taken on the subroutine itself before
-execution. The semantics of the lock are exactly those of one
-explicitly taken with the C<lock> operator immediately after the
-subroutine is entered.
+method is to be called by multiple threads. When the B<package>
+attribute is set then before executing the subroutine or method
+perl acquires a lock on the package in which the subroutine is
+defined. 
+
+Otherwise, when set on a method subroutine (i.e. one
+marked with the B<method> attribute above), perl ensures that any
+invocation of it implicitly locks its first argument before
+execution. When set on a non-method subroutine,
+(without a B<package> attribute) perl ensures that a lock is taken 
+on the subroutine itself before execution. The semantics of the
+lock are exactly those of one explicitly taken with the C<lock> 
+operator immediately after the subroutine is entered.
 
 =back
 
diff --git a/ext/attrs/attrs.xs b/ext/attrs/attrs.xs
index dae612a..2de522a 100644
--- a/ext/attrs/attrs.xs
+++ b/ext/attrs/attrs.xs
@@ -9,6 +9,8 @@ get_flag(char *attr)
 	return CVf_METHOD;
     else if (strnEQ(attr, "locked", 6))
 	return CVf_LOCKED;
+    else if (strnEQ(attr, "package", 7))
+	return CVf_PACKAGE;
     else
 	return 0;
 }
@@ -56,4 +58,6 @@ SV *	sub
 	    XPUSHs(sv_2mortal(newSVpv("method", 0)));
 	if (CvFLAGS(sub) & CVf_LOCKED)
 	    XPUSHs(sv_2mortal(newSVpv("locked", 0)));
+	if (CvFLAGS(sub) & CVf_PACKAGE)
+	    XPUSHs(sv_2mortal(newSVpv("package", 0)));
 
diff --git a/pp_hot.c b/pp_hot.c
index 0422605..41f2aee 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1923,8 +1923,11 @@ PP(pp_entersub)
      */
     MUTEX_LOCK(CvMUTEXP(cv));
     if (CvFLAGS(cv) & CVf_LOCKED) {
-	MAGIC *mg;	
-	if (CvFLAGS(cv) & CVf_METHOD) {
+	MAGIC *mg;	  
+	if (CvFLAGS(cv) & CVf_PACKAGE) {
+	    sv = (SV *) CvGV(cv);
+	}
+	else if (CvFLAGS(cv) & CVf_METHOD) {
 	    if (SP > stack_base + TOPMARK)
 		sv = *(stack_base + TOPMARK + 1);
 	    else {