Change 33901 by [EMAIL PROTECTED] on 2008/05/21 13:35:43
Add Perl_croak_xs_usage(), which reduces a lot of explicit calls of
the form Perl_croak(aTHX_ "Usage %s::%s(%s)", "ouch" "awk", "eee_yow");
down to croak_xs_usage(cv, "eee_yow"); and refactor all the core XS
code to use it. This adds () to the error messages for attributes::*
Affected files ...
... //depot/perl/embed.fnc#615 edit
... //depot/perl/embed.h#761 edit
... //depot/perl/global.sym#356 edit
... //depot/perl/mro.c#47 edit
... //depot/perl/pod/perlapi.pod#331 edit
... //depot/perl/proto.h#949 edit
... //depot/perl/universal.c#189 edit
... //depot/perl/xsutils.c#55 edit
Differences ...
==== //depot/perl/embed.fnc#615 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#614~33766~ 2008-04-30 01:17:51.000000000 -0700
+++ perl/embed.fnc 2008-05-21 06:35:43.000000000 -0700
@@ -148,6 +148,9 @@
: croak()'s first parm can be NULL. Otherwise, mod_perl breaks.
Afprd |void |croak |NULLOK const char* pat|...
Apr |void |vcroak |NULLOK const char* pat|NULLOK va_list* args
+Aprd |void |croak_xs_usage |NN const CV *const cv \
+ |NN const char *const params
+
#if defined(PERL_IMPLICIT_CONTEXT)
Afnrp |void |croak_nocontext|NULLOK const char* pat|...
Afnp |OP* |die_nocontext |NN const char* pat|...
==== //depot/perl/embed.h#761 (text+w) ====
Index: perl/embed.h
--- perl/embed.h#760~33766~ 2008-04-30 01:17:51.000000000 -0700
+++ perl/embed.h 2008-05-21 06:35:43.000000000 -0700
@@ -104,6 +104,7 @@
#endif
#define croak Perl_croak
#define vcroak Perl_vcroak
+#define croak_xs_usage Perl_croak_xs_usage
#if defined(PERL_IMPLICIT_CONTEXT)
#define croak_nocontext Perl_croak_nocontext
#define die_nocontext Perl_die_nocontext
@@ -2421,6 +2422,7 @@
#define create_eval_scope(a) Perl_create_eval_scope(aTHX_ a)
#endif
#define vcroak(a,b) Perl_vcroak(aTHX_ a,b)
+#define croak_xs_usage(a,b) Perl_croak_xs_usage(aTHX_ a,b)
#if defined(PERL_IMPLICIT_CONTEXT)
#endif
#ifdef PERL_CORE
==== //depot/perl/global.sym#356 (text+w) ====
Index: perl/global.sym
--- perl/global.sym#355~33702~ 2008-04-17 00:58:29.000000000 -0700
+++ perl/global.sym 2008-05-21 06:35:43.000000000 -0700
@@ -61,6 +61,7 @@
Perl_my_chsize
Perl_croak
Perl_vcroak
+Perl_croak_xs_usage
Perl_croak_nocontext
Perl_die_nocontext
Perl_deb_nocontext
==== //depot/perl/mro.c#47 (text) ====
Index: perl/mro.c
--- perl/mro.c#46~33367~ 2008-02-25 02:54:47.000000000 -0800
+++ perl/mro.c 2008-05-21 06:35:43.000000000 -0700
@@ -707,10 +707,8 @@
HV* class_stash;
SV* classname;
- PERL_UNUSED_ARG(cv);
-
if(items < 1 || items > 2)
- Perl_croak(aTHX_ "Usage: mro::get_linear_isa(classname [, type ])");
+ croak_xs_usage(cv, "classname [, type ]");
classname = ST(0);
class_stash = gv_stashsv(classname, 0);
@@ -748,10 +746,8 @@
HV* class_stash;
struct mro_meta* meta;
- PERL_UNUSED_ARG(cv);
-
if (items != 2)
- Perl_croak(aTHX_ "Usage: mro::set_mro(classname, type)");
+ croak_xs_usage(cv, "classname, type");
classname = ST(0);
whichstr = SvPV_nolen(ST(1));
@@ -783,10 +779,8 @@
SV* classname;
HV* class_stash;
- PERL_UNUSED_ARG(cv);
-
if (items != 1)
- Perl_croak(aTHX_ "Usage: mro::get_mro(classname)");
+ croak_xs_usage(cv, "classname");
classname = ST(0);
class_stash = gv_stashsv(classname, 0);
@@ -806,10 +800,8 @@
HV* isarev;
AV* ret_array;
- PERL_UNUSED_ARG(cv);
-
if (items != 1)
- Perl_croak(aTHX_ "Usage: mro::get_isarev(classname)");
+ croak_xs_usage(cv, "classname");
classname = ST(0);
@@ -842,10 +834,8 @@
STRLEN classname_len;
HE* he;
- PERL_UNUSED_ARG(cv);
-
if (items != 1)
- Perl_croak(aTHX_ "Usage: mro::is_universal(classname)");
+ croak_xs_usage(cv, "classname");
classname = ST(0);
@@ -866,10 +856,8 @@
dVAR;
dXSARGS;
- PERL_UNUSED_ARG(cv);
-
if (items != 0)
- Perl_croak(aTHX_ "Usage: mro::invalidate_all_method_caches()");
+ croak_xs_usage(cv, "");
PL_sub_generation++;
@@ -883,10 +871,8 @@
SV* classname;
HV* class_stash;
- PERL_UNUSED_ARG(cv);
-
if(items != 1)
- Perl_croak(aTHX_ "Usage: mro::method_changed_in(classname)");
+ croak_xs_usage(cv, "classname");
classname = ST(0);
@@ -905,10 +891,8 @@
SV* classname;
HV* class_stash;
- PERL_UNUSED_ARG(cv);
-
if(items != 1)
- Perl_croak(aTHX_ "Usage: mro::get_pkg_gen(classname)");
+ croak_xs_usage(cv, "classname");
classname = ST(0);
==== //depot/perl/pod/perlapi.pod#331 (text+w) ====
Index: perl/pod/perlapi.pod
--- perl/pod/perlapi.pod#330~33618~ 2008-03-31 12:48:26.000000000 -0700
+++ perl/pod/perlapi.pod 2008-05-21 06:35:43.000000000 -0700
@@ -3931,6 +3931,23 @@
=over 8
+=item croak_xs_usage
+X<croak_xs_usage>
+
+A specialised variant of C<croak()> for emitting the usage message for xsubs
+
+ croak_xs_usage(cv, "eee_yow");
+
+works out the package name and subroutine name from C<cv>, and then calls
+C<croak()>. Hence if C<cv> is C<&ouch::awk>, it would call C<croak> as:
+
+ Perl_croak(aTHX_ "Usage %s::%s(%s)", "ouch" "awk", "eee_yow");
+
+ void croak_xs_usage(CV *const cv, const char *const params)
+
+=for hackers
+Found in file universal.c
+
=item get_sv
X<get_sv>
==== //depot/perl/proto.h#949 (text+w) ====
Index: perl/proto.h
--- perl/proto.h#948~33766~ 2008-04-30 01:17:51.000000000 -0700
+++ perl/proto.h 2008-05-21 06:35:43.000000000 -0700
@@ -327,6 +327,14 @@
PERL_CALLCONV void Perl_vcroak(pTHX_ const char* pat, va_list* args)
__attribute__noreturn__;
+PERL_CALLCONV void Perl_croak_xs_usage(pTHX_ const CV *const cv, const
char *const params)
+ __attribute__noreturn__
+ __attribute__nonnull__(pTHX_1)
+ __attribute__nonnull__(pTHX_2);
+#define PERL_ARGS_ASSERT_CROAK_XS_USAGE \
+ assert(cv); assert(params)
+
+
#if defined(PERL_IMPLICIT_CONTEXT)
PERL_CALLCONV void Perl_croak_nocontext(const char* pat, ...)
__attribute__noreturn__
==== //depot/perl/universal.c#189 (text) ====
Index: perl/universal.c
--- perl/universal.c#188~33291~ 2008-02-12 05:15:20.000000000 -0800
+++ perl/universal.c 2008-05-21 06:35:43.000000000 -0700
@@ -296,15 +296,50 @@
newXS("Tie::Hash::NamedCapture::flags", XS_Tie_Hash_NamedCapture_flags,
file);
}
+/*
+=for apidoc croak_xs_usage
+
+A specialised variant of C<croak()> for emitting the usage message for xsubs
+
+ croak_xs_usage(cv, "eee_yow");
+
+works out the package name and subroutine name from C<cv>, and then calls
+C<croak()>. Hence if C<cv> is C<&ouch::awk>, it would call C<croak> as:
+
+ Perl_croak(aTHX_ "Usage %s::%s(%s)", "ouch" "awk", "eee_yow");
+
+=cut
+*/
+
+void
+Perl_croak_xs_usage(pTHX_ const CV *const cv, const char *const params)
+{
+ const GV *const gv = CvGV(cv);
+
+ PERL_ARGS_ASSERT_CROAK_XS_USAGE;
+
+ if (gv) {
+ const char *const gvname = GvNAME(gv);
+ const HV *const stash = GvSTASH(gv);
+ const char *const hvname = stash ? HvNAME_get(stash) : NULL;
+
+ if (hvname)
+ Perl_croak(aTHX_ "Usage: %s::%s(%s)", hvname, gvname, params);
+ else
+ Perl_croak(aTHX_ "Usage: %s(%s)", gvname, params);
+ } else {
+ /* Pants. I don't think that it should be possible to get here. */
+ Perl_croak(aTHX_ "Usage: CODE(%"UVXf")(%s)", (UV)cv, params);
+ }
+}
XS(XS_UNIVERSAL_isa)
{
dVAR;
dXSARGS;
- PERL_UNUSED_ARG(cv);
if (items != 2)
- Perl_croak(aTHX_ "Usage: UNIVERSAL::isa(reference, kind)");
+ croak_xs_usage(cv, "reference, kind");
else {
SV * const sv = ST(0);
const char *name;
@@ -330,10 +365,9 @@
const char *name;
SV *rv;
HV *pkg = NULL;
- PERL_UNUSED_ARG(cv);
if (items != 2)
- Perl_croak(aTHX_ "Usage: UNIVERSAL::can(object-ref, method)");
+ croak_xs_usage(cv, "object-ref, method");
sv = ST(0);
@@ -471,9 +505,8 @@
{
dVAR;
dXSARGS;
- PERL_UNUSED_ARG(cv);
if (items > 3)
- Perl_croak(aTHX_ "Usage: version::new(class, version)");
+ croak_xs_usage(cv, "class, version");
SP -= items;
{
SV *vs = ST(1);
@@ -507,9 +540,8 @@
{
dVAR;
dXSARGS;
- PERL_UNUSED_ARG(cv);
if (items < 1)
- Perl_croak(aTHX_ "Usage: version::stringify(lobj, ...)");
+ croak_xs_usage(cv, "lobj, ...");
SP -= items;
{
SV * lobj;
@@ -531,9 +563,8 @@
{
dVAR;
dXSARGS;
- PERL_UNUSED_ARG(cv);
if (items < 1)
- Perl_croak(aTHX_ "Usage: version::numify(lobj, ...)");
+ croak_xs_usage(cv, "lobj, ...");
SP -= items;
{
SV * lobj;
@@ -555,9 +586,8 @@
{
dVAR;
dXSARGS;
- PERL_UNUSED_ARG(cv);
if (items < 1)
- Perl_croak(aTHX_ "Usage: version::normal(lobj, ...)");
+ croak_xs_usage(cv, "lobj, ...");
SP -= items;
{
SV * lobj;
@@ -579,9 +609,8 @@
{
dVAR;
dXSARGS;
- PERL_UNUSED_ARG(cv);
if (items < 1)
- Perl_croak(aTHX_ "Usage: version::vcmp(lobj, ...)");
+ croak_xs_usage(cv, "lobj, ...");
SP -= items;
{
SV * lobj;
@@ -625,9 +654,8 @@
{
dVAR;
dXSARGS;
- PERL_UNUSED_ARG(cv);
if (items < 1)
- Perl_croak(aTHX_ "Usage: version::boolean(lobj, ...)");
+ croak_xs_usage(cv, "lobj, ...");
SP -= items;
if (sv_derived_from(ST(0), "version")) {
SV * const lobj = SvRV(ST(0));
@@ -644,9 +672,8 @@
{
dVAR;
dXSARGS;
- PERL_UNUSED_ARG(cv);
if (items < 1)
- Perl_croak(aTHX_ "Usage: version::noop(lobj, ...)");
+ croak_xs_usage(cv, "lobj, ...");
if (sv_derived_from(ST(0), "version"))
Perl_croak(aTHX_ "operation not supported with version object");
else
@@ -660,9 +687,8 @@
{
dVAR;
dXSARGS;
- PERL_UNUSED_ARG(cv);
if (items != 1)
- Perl_croak(aTHX_ "Usage: version::is_alpha(lobj)");
+ croak_xs_usage(cv, "lobj");
SP -= items;
if (sv_derived_from(ST(0), "version")) {
SV * const lobj = ST(0);
@@ -681,9 +707,8 @@
{
dVAR;
dXSARGS;
- PERL_UNUSED_ARG(cv);
if (items != 1)
- Perl_croak(aTHX_ "Usage: version::qv(ver)");
+ croak_xs_usage(cv, "ver");
SP -= items;
{
SV * ver = ST(0);
@@ -707,9 +732,8 @@
{
dVAR;
dXSARGS;
- PERL_UNUSED_ARG(cv);
if (items != 1)
- Perl_croak(aTHX_ "Usage: utf8::is_utf8(sv)");
+ croak_xs_usage(cv, "sv");
else {
const SV * const sv = ST(0);
if (SvUTF8(sv))
@@ -724,9 +748,8 @@
{
dVAR;
dXSARGS;
- PERL_UNUSED_ARG(cv);
if (items != 1)
- Perl_croak(aTHX_ "Usage: utf8::valid(sv)");
+ croak_xs_usage(cv, "sv");
else {
SV * const sv = ST(0);
STRLEN len;
@@ -743,9 +766,8 @@
{
dVAR;
dXSARGS;
- PERL_UNUSED_ARG(cv);
if (items != 1)
- Perl_croak(aTHX_ "Usage: utf8::encode(sv)");
+ croak_xs_usage(cv, "sv");
sv_utf8_encode(ST(0));
XSRETURN_EMPTY;
}
@@ -754,9 +776,8 @@
{
dVAR;
dXSARGS;
- PERL_UNUSED_ARG(cv);
if (items != 1)
- Perl_croak(aTHX_ "Usage: utf8::decode(sv)");
+ croak_xs_usage(cv, "sv");
else {
SV * const sv = ST(0);
const bool RETVAL = sv_utf8_decode(sv);
@@ -770,9 +791,8 @@
{
dVAR;
dXSARGS;
- PERL_UNUSED_ARG(cv);
if (items != 1)
- Perl_croak(aTHX_ "Usage: utf8::upgrade(sv)");
+ croak_xs_usage(cv, "sv");
else {
SV * const sv = ST(0);
STRLEN RETVAL;
@@ -788,9 +808,8 @@
{
dVAR;
dXSARGS;
- PERL_UNUSED_ARG(cv);
if (items < 1 || items > 2)
- Perl_croak(aTHX_ "Usage: utf8::downgrade(sv, failok=0)");
+ croak_xs_usage(cv, "sv, failok=0");
else {
SV * const sv = ST(0);
const bool failok = (items < 2) ? 0 : (int)SvIV(ST(1));
@@ -807,10 +826,9 @@
dVAR;
dXSARGS;
const UV uv = SvUV(ST(0));
- PERL_UNUSED_ARG(cv);
if (items > 1)
- Perl_croak(aTHX_ "Usage: utf8::native_to_unicode(sv)");
+ croak_xs_usage(cv, "sv");
ST(0) = sv_2mortal(newSViv(NATIVE_TO_UNI(uv)));
XSRETURN(1);
@@ -821,10 +839,9 @@
dVAR;
dXSARGS;
const UV uv = SvUV(ST(0));
- PERL_UNUSED_ARG(cv);
if (items > 1)
- Perl_croak(aTHX_ "Usage: utf8::unicode_to_native(sv)");
+ croak_xs_usage(cv, "sv");
ST(0) = sv_2mortal(newSViv(UNI_TO_NATIVE(uv)));
XSRETURN(1);
@@ -878,10 +895,9 @@
{
dVAR;
dXSARGS;
- PERL_UNUSED_ARG(cv);
if (items != 1)
- Perl_croak(aTHX_ "Usage: UNIVERSAL::hv_clear_placeholders(hv)");
+ croak_xs_usage(cv, "hv");
else {
HV * const hv = (HV *) SvRV(ST(0));
hv_clear_placeholders(hv);
@@ -899,9 +915,8 @@
{
dVAR;
dXSARGS;
- PERL_UNUSED_ARG(cv);
if (items < 1 || items % 2 == 0)
- Perl_croak(aTHX_ "Usage: PerlIO_get_layers(filehandle[,args])");
+ croak_xs_usage(cv, "filehandle[,args]");
#ifdef USE_PERLIO
{
SV * sv;
@@ -1050,7 +1065,6 @@
{
dVAR;
dXSARGS;
- PERL_UNUSED_ARG(cv);
if (SvROK(ST(0))) {
const HV * const hv = (HV *) SvRV(ST(0));
if (items == 1 && SvTYPE(hv) == SVt_PVHV) {
@@ -1070,7 +1084,7 @@
PERL_UNUSED_VAR(cv);
if (items != 1)
- Perl_croak(aTHX_ "Usage: %s(%s)", "re::is_regexp", "sv");
+ croak_xs_usage(cv, "sv");
SP -= items;
@@ -1087,10 +1101,9 @@
SV * ret;
dVAR;
dXSARGS;
- PERL_UNUSED_ARG(cv);
if (items != 0)
- Perl_croak(aTHX_ "Usage: %s(%s)", "re::regnames_count", "");
+ croak_xs_usage(cv, "");
SP -= items;
@@ -1117,10 +1130,9 @@
REGEXP * rx;
U32 flags;
SV * ret;
- PERL_UNUSED_ARG(cv);
if (items < 1 || items > 2)
- Perl_croak(aTHX_ "Usage: %s(%s)", "re::regname", "name[, all ]");
+ croak_xs_usage(cv, "name[, all ]");
SP -= items;
@@ -1158,10 +1170,9 @@
I32 length;
I32 i;
SV **entry;
- PERL_UNUSED_ARG(cv);
if (items > 1)
- Perl_croak(aTHX_ "Usage: %s(%s)", "re::regnames", "[all]");
+ croak_xs_usage(cv, "[all]");
rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
@@ -1205,10 +1216,9 @@
dVAR;
dXSARGS;
REGEXP *re;
- PERL_UNUSED_ARG(cv);
if (items != 1)
- Perl_croak(aTHX_ "Usage: %s(%s)", "re::regexp_pattern", "sv");
+ croak_xs_usage(cv, "sv");
SP -= items;
@@ -1298,10 +1308,9 @@
REGEXP * rx;
U32 flags;
SV * ret;
- PERL_UNUSED_ARG(cv);
if (items != 2)
- Perl_croak(aTHX_ "Usage: Tie::Hash::NamedCapture::STORE($key,
$flags)");
+ croak_xs_usage(cv, "$key, $flags");
rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
@@ -1332,10 +1341,9 @@
dXSARGS;
REGEXP * rx;
U32 flags;
- PERL_UNUSED_ARG(cv);
if (items != 3)
- Perl_croak(aTHX_ "Usage: Tie::Hash::NamedCapture::STORE($key, $value,
$flags)");
+ croak_xs_usage(cv, "$key, $value, $flags");
rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
@@ -1358,10 +1366,9 @@
dXSARGS;
REGEXP * rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
U32 flags;
- PERL_UNUSED_ARG(cv);
if (items != 2)
- Perl_croak(aTHX_ "Usage: Tie::Hash::NamedCapture::DELETE($key,
$flags)");
+ croak_xs_usage(cv, "$key, $flags");
if (!rx)
Perl_croak(aTHX_ PL_no_modify);
@@ -1378,10 +1385,9 @@
dXSARGS;
REGEXP * rx;
U32 flags;
- PERL_UNUSED_ARG(cv);
if (items != 1)
- Perl_croak(aTHX_ "Usage: Tie::Hash::NamedCapture::CLEAR($flags)");
+ croak_xs_usage(cv, "$flags");
rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
@@ -1401,10 +1407,9 @@
REGEXP * rx;
U32 flags;
SV * ret;
- PERL_UNUSED_ARG(cv);
if (items != 2)
- Perl_croak(aTHX_ "Usage: Tie::Hash::NamedCapture::EXISTS($key,
$flags)");
+ croak_xs_usage(cv, "$key, $flags");
rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
@@ -1430,10 +1435,9 @@
REGEXP * rx;
U32 flags;
SV * ret;
- PERL_UNUSED_ARG(cv);
if (items != 1)
- Perl_croak(aTHX_ "Usage: Tie::Hash::NamedCapture::FIRSTKEY()");
+ croak_xs_usage(cv, "");
rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
@@ -1463,10 +1467,9 @@
REGEXP * rx;
U32 flags;
SV * ret;
- PERL_UNUSED_ARG(cv);
if (items != 2)
- Perl_croak(aTHX_ "Usage: Tie::Hash::NamedCapture::NEXTKEY($lastkey)");
+ croak_xs_usage(cv, "$lastkey");
rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
@@ -1495,10 +1498,9 @@
REGEXP * rx;
U32 flags;
SV * ret;
- PERL_UNUSED_ARG(cv);
if (items != 1)
- Perl_croak(aTHX_ "Usage: Tie::Hash::NamedCapture::SCALAR()");
+ croak_xs_usage(cv, "");
rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
@@ -1525,10 +1527,9 @@
{
dVAR;
dXSARGS;
- PERL_UNUSED_ARG(cv);
if (items != 0)
- Perl_croak(aTHX_ "Usage: Tie::Hash::NamedCapture::flags()");
+ croak_xs_usage(cv, "");
mXPUSHu(RXapif_ONE);
mXPUSHu(RXapif_ALL);
==== //depot/perl/xsutils.c#55 (text) ====
Index: perl/xsutils.c
--- perl/xsutils.c#54~32819~ 2008-01-03 09:42:27.000000000 -0800
+++ perl/xsutils.c 2008-05-21 06:35:43.000000000 -0700
@@ -150,10 +150,9 @@
{
dVAR;
dXSARGS;
- PERL_UNUSED_ARG(cv);
if( items > 1 )
- Perl_croak(aTHX_ "Usage: attributes::bootstrap $module");
+ croak_xs_usage(cv, "$module");
newXS("attributes::_modify_attrs", XS_attributes__modify_attrs, file);
newXSproto("attributes::_guess_stash", XS_attributes__guess_stash, file,
"$");
@@ -168,12 +167,10 @@
dVAR;
dXSARGS;
SV *rv, *sv;
- PERL_UNUSED_ARG(cv);
if (items < 1) {
usage:
- Perl_croak(aTHX_
- "Usage: attributes::_modify_attrs $reference, @attributes");
+ croak_xs_usage(cv, "@attributes");
}
rv = ST(0);
@@ -192,12 +189,10 @@
dXSARGS;
SV *rv, *sv;
cv_flags_t cvflags;
- PERL_UNUSED_ARG(cv);
if (items != 1) {
usage:
- Perl_croak(aTHX_
- "Usage: attributes::_fetch_attrs $reference");
+ croak_xs_usage(cv, "$reference");
}
rv = ST(0);
@@ -237,12 +232,10 @@
dXSARGS;
SV *rv, *sv;
dXSTARG;
- PERL_UNUSED_ARG(cv);
if (items != 1) {
usage:
- Perl_croak(aTHX_
- "Usage: attributes::_guess_stash $reference");
+ croak_xs_usage(cv, "$reference");
}
rv = ST(0);
@@ -287,12 +280,10 @@
dXSARGS;
SV *rv, *sv;
dXSTARG;
- PERL_UNUSED_ARG(cv);
if (items != 1) {
usage:
- Perl_croak(aTHX_
- "Usage: attributes::reftype $reference");
+ croak_xs_usage(cv, "$reference");
}
rv = ST(0);
End of Patch.
