summaryrefslogtreecommitdiff
path: root/universal.c
diff options
context:
space:
mode:
authorJarkko Hietaniemi <jhi@iki.fi>2002-03-12 15:41:23 +0000
committerJarkko Hietaniemi <jhi@iki.fi>2002-03-12 15:41:23 +0000
commit2956957731badfc3e16c029c1f22e4098fb8c46a (patch)
tree09c3c57a65da3e7734bd1174dbab4c81f38ef203 /universal.c
parent7530c94cc4e2a136116a8545073135072061ee62 (diff)
downloadperl-2956957731badfc3e16c029c1f22e4098fb8c46a.tar.gz
Move the readonly interface back to universal.c,
(new name: Internals::SvREADONLY), remove Data::Util, move Hash::Util to lib, also introduce refcnt interface (Internals::SvREFCNT). Make both the new interfaces to be more sane so that if they set the value, they return the new value, not the old one. p4raw-id: //depot/perl@15201
Diffstat (limited to 'universal.c')
-rw-r--r--universal.c40
1 files changed, 40 insertions, 0 deletions
diff --git a/universal.c b/universal.c
index ae12e27984..16000f723d 100644
--- a/universal.c
+++ b/universal.c
@@ -167,6 +167,8 @@ XS(XS_utf8_upgrade);
XS(XS_utf8_downgrade);
XS(XS_utf8_unicode_to_native);
XS(XS_utf8_native_to_unicode);
+XS(XS_Internals_SvREADONLY);
+XS(XS_Internals_SvREFCNT);
void
Perl_boot_core_UNIVERSAL(pTHX)
@@ -183,6 +185,8 @@ Perl_boot_core_UNIVERSAL(pTHX)
newXS("utf8::downgrade", XS_utf8_downgrade, file);
newXS("utf8::native_to_unicode", XS_utf8_native_to_unicode, file);
newXS("utf8::unicode_to_native", XS_utf8_unicode_to_native, file);
+ newXSproto("Internals::SvREADONLY",XS_Internals_SvREADONLY, file, "\\[$%@];$");
+ newXSproto("Internals::SvREFCNT",XS_Internals_SvREFCNT, file, "\\[$%@];$");
}
@@ -458,3 +462,39 @@ XS(XS_utf8_unicode_to_native)
XSRETURN(1);
}
+XS(XS_Internals_SvREADONLY)
+{
+ dXSARGS;
+ SV *sv = SvRV(ST(0));
+ if (items == 1) {
+ if (SvREADONLY(sv))
+ XSRETURN_YES;
+ else
+ XSRETURN_NO;
+ }
+ else if (items == 2) {
+ if (SvTRUE(ST(1))) {
+ SvREADONLY_on(sv);
+ XSRETURN_YES;
+ }
+ else {
+ SvREADONLY_off(sv);
+ XSRETURN_NO;
+ }
+ }
+ XSRETURN_UNDEF;
+}
+
+XS(XS_Internals_SvREFCNT)
+{
+ dXSARGS;
+ SV *sv = SvRV(ST(0));
+ if (items == 1)
+ XSRETURN_IV(SvREFCNT(sv) - 1); /* minus the SvRV above */
+ else if (items == 2) {
+ SvREFCNT(sv) = SvIV(ST(1));
+ XSRETURN_IV(SvREFCNT(sv));
+ }
+ XSRETURN_UNDEF;
+}
+