-/* $Id: Name.xs,v 1.5 2004/08/18 13:21:44 xmath Exp $
- * Copyright (C) 2004 Matthijs van Duin. All rights reserved.
+/* Copyright (C) 2004, 2008 Matthijs van Duin. All rights reserved.
* This program is free software; you can redistribute it and/or modify
* it under the same terms as Perl itself.
*/
#include "perl.h"
#include "XSUB.h"
-#ifdef USE_5005THREADS
-#error "Not compatible with 5.005 threads"
+static MGVTBL subname_vtbl;
+
+#ifndef PERL_MAGIC_ext
+# define PERL_MAGIC_ext '~'
+#endif
+
+#ifndef SvMAGIC_set
+#define SvMAGIC_set(sv, val) (SvMAGIC(sv) = (val))
#endif
+
MODULE = Sub::Name PACKAGE = Sub::Name
PROTOTYPES: DISABLE
}
gv = (GV *) newSV(0);
gv_init(gv, stash, name, s - name, TRUE);
- av_store((AV *) AvARRAY(CvPADLIST(cv))[0], 0, (SV *) gv);
+#ifndef USE_5005THREADS
+ if (CvPADLIST(cv)) {
+ /* cheap way to refcount the gv */
+ av_store((AV *) AvARRAY(CvPADLIST(cv))[0], 0, (SV *) gv);
+ } else
+#endif
+ {
+ /* expensive way to refcount the gv */
+ MAGIC *mg = SvMAGIC(cv);
+ while (mg && mg->mg_virtual != &subname_vtbl)
+ mg = mg->mg_moremagic;
+ if (!mg) {
+ Newz(702, mg, 1, MAGIC);
+ mg->mg_moremagic = SvMAGIC(cv);
+ mg->mg_type = PERL_MAGIC_ext;
+ mg->mg_virtual = &subname_vtbl;
+ SvMAGIC_set(cv, mg);
+ }
+ if (mg->mg_flags & MGf_REFCOUNTED)
+ SvREFCNT_dec(mg->mg_obj);
+ mg->mg_flags |= MGf_REFCOUNTED;
+ mg->mg_obj = (SV *) gv;
+ }
CvGV(cv) = gv;
PUSHs(sub);