typedef struct {
HV *map;
- AV *next_pkg;
- AV *next_name;
CV *placeholder;
#if SO_THREADSAFE
tTHX owner;
/* PerlMemShared_free() needs the [ap]PTBLMS_? default values */
#define ptable_store(T, K, V) ptable_store(aPTBLMS_ (T), (K), (V))
-STATIC ptable *sub_op_name = NULL;
+STATIC ptable *so_op_name = NULL;
#ifdef USE_ITHREADS
-STATIC perl_mutex sub_op_name_mutex;
+STATIC perl_mutex so_op_name_mutex;
#endif
typedef struct {
STRLEN len;
char buf;
-} sub_op_name_t;
+} so_op_name_t;
/* --- Public API ---------------------------------------------------------- */
#include "sub_op.h"
-void sub_op_register(pTHX_ const sub_op_keyword *k) {
- SV *key = newSViv(PTR2IV(k->pp));
+void sub_op_register(pTHX_ const sub_op_config_t *c) {
+ SV *key = newSViv(PTR2IV(c->pp));
if (!PL_custom_op_names)
PL_custom_op_names = newHV();
- (void) hv_store_ent(PL_custom_op_names, key, newSVpv(k->name, k->len), 0);
+ (void) hv_store_ent(PL_custom_op_names, key, newSVpv(c->name, c->namelen), 0);
if (!PL_custom_op_descs)
PL_custom_op_descs = newHV();
- (void) hv_store_ent(PL_custom_op_descs, key, newSVpv(k->name, k->len), 0);
+ (void) hv_store_ent(PL_custom_op_descs, key, newSVpv(c->name, c->namelen), 0);
- if (k->check) {
- SV *check = newSViv(PTR2IV(k->check));
- sv_magicext(key, check, PERL_MAGIC_ext, NULL, k->ud, 0);
+ if (c->check) {
+ SV *check = newSViv(PTR2IV(c->check));
+ sv_magicext(key, check, PERL_MAGIC_ext, NULL, c->ud, 0);
SvREFCNT_dec(check);
}
{
dMY_CXT;
- (void) hv_store(MY_CXT.map, k->name, k->len, key, 0);
+ (void) hv_store(MY_CXT.map, c->name, c->namelen, key, 0);
}
}
/* --- Private helpers ----------------------------------------------------- */
-#define SO_LINKLIST(O) ((O)->op_next ? (O)->op_next : sub_op_linklist(O))
-
-STATIC OP *sub_op_linklist(pTHX_ OP *o) {
-#define sub_op_linklist(O) sub_op_linklist(aTHX_ (O))
- OP *first;
-
- if (o->op_next)
- return o->op_next;
-
- /* establish postfix order */
- first = cUNOPo->op_first;
- if (first) {
- register OP *kid;
- o->op_next = SO_LINKLIST(first);
- kid = first;
- for (;;) {
- if (kid->op_sibling) {
- kid->op_next = SO_LINKLIST(kid->op_sibling);
- kid = kid->op_sibling;
- } else {
- kid->op_next = o;
- break;
- }
- }
- }
- else
- o->op_next = o;
-
- return o->op_next;
-}
-
-STATIC IV sub_op_hint(pTHX) {
-#define sub_op_hint() sub_op_hint(aTHX)
+STATIC IV so_hint(pTHX) {
+#define so_hint() so_hint(aTHX)
SV *hint;
#if SO_HAS_PERL(5, 9, 5)
return (SvOK(hint) && SvIOK(hint)) ? SvIVX(hint) : 0;
}
-STATIC OP *(*sub_op_old_ck_entersub)(pTHX_ OP *) = 0;
+STATIC OP *(*so_old_ck_entersub)(pTHX_ OP *) = 0;
-STATIC OP *sub_op_ck_entersub(pTHX_ OP *o) {
- o = CALL_FPTR(sub_op_old_ck_entersub)(aTHX_ o);
+STATIC OP *so_ck_entersub(pTHX_ OP *o) {
+ o = CALL_FPTR(so_old_ck_entersub)(aTHX_ o);
- if (sub_op_hint()) {
+ if (so_hint()) {
OP *ex_list, *rv2cv, *gvop, *last_arg = NULL;
GV *gv;
gv = cGVOPx_gv(gvop);
{
- HV *stash = GvSTASH(gv);
SV *pp_sv, **svp;
CV *cv = NULL;
const char *name = GvNAME(gv);
if (gv && SvTYPE(gv) >= SVt_PVGV && (cv = GvCV(gv)) == MY_CXT.placeholder) {
SvREFCNT_dec(cv);
GvCV(gv) = NULL;
- if (!GvSV(gv) && !GvAV(gv) && !GvHV(gv) && !GvIO(gv) && !GvFORM(gv)) {
- (void) hv_delete(stash, name, len, G_DISCARD);
- }
}
o->op_type = OP_CUSTOM;
}
}
- sub_op_linklist(o);
-
{
- sub_op_name_t *on = PerlMemShared_malloc(sizeof(*on) + len);
+ so_op_name_t *on = PerlMemShared_malloc(sizeof(*on) + len);
Copy(name, &on->buf, len, char);
(&on->buf)[len] = '\0';
on->len = len;
#ifdef USE_ITHREADS
- MUTEX_LOCK(&sub_op_name_mutex);
+ MUTEX_LOCK(&so_op_name_mutex);
#endif /* USE_ITHREADS */
- ptable_store(sub_op_name, o, on);
+ ptable_store(so_op_name, o, on);
#ifdef USE_ITHREADS
- MUTEX_UNLOCK(&sub_op_name_mutex);
+ MUTEX_UNLOCK(&so_op_name_mutex);
#endif /* USE_ITHREADS */
}
}
return o;
}
-STATIC OP *(*sub_op_old_ck_gelem)(pTHX_ OP *) = 0;
+STATIC OP *(*so_old_ck_gelem)(pTHX_ OP *) = 0;
-STATIC OP *sub_op_ck_gelem(pTHX_ OP *o) {
- o = CALL_FPTR(sub_op_old_ck_entersub)(aTHX_ o);
+STATIC OP *so_ck_gelem(pTHX_ OP *o) {
+ o = CALL_FPTR(so_old_ck_entersub)(aTHX_ o);
- if (sub_op_hint()) {
+ if (so_hint()) {
OP *rv2gv, *gvop;
GV *gv;
if (gv && SvTYPE(gv) >= SVt_PVGV && (cv = GvCV(gv)) == MY_CXT.placeholder) {
SvREFCNT_dec(cv);
GvCV(gv) = NULL;
- if (!GvSV(gv) && !GvAV(gv) && !GvHV(gv) && !GvIO(gv) && !GvFORM(gv)) {
- (void)hv_delete(GvSTASH(gv), GvNAME_get(gv), GvNAMELEN_get(gv), G_DISCARD);
- }
}
}
}
BOOT:
{
- sub_op_name = ptable_new();
+ so_op_name = ptable_new();
#ifdef USE_ITHREADS
- MUTEX_INIT(&sub_op_name_mutex);
+ MUTEX_INIT(&so_op_name_mutex);
#endif
MY_CXT_INIT;
MY_CXT.map = newHV();
- MY_CXT.next_pkg = newAV();
- MY_CXT.next_name = newAV();
MY_CXT.placeholder = NULL;
#if SO_THREADSAFE
MY_CXT.owner = aTHX;
#endif /* SO_THREADSAFE */
- sub_op_old_ck_entersub = PL_check[OP_ENTERSUB];
- PL_check[OP_ENTERSUB] = sub_op_ck_entersub;
- sub_op_old_ck_gelem = PL_check[OP_GELEM];
- PL_check[OP_GELEM] = sub_op_ck_gelem;
+ so_old_ck_entersub = PL_check[OP_ENTERSUB];
+ PL_check[OP_ENTERSUB] = so_ck_entersub;
+ so_old_ck_gelem = PL_check[OP_GELEM];
+ PL_check[OP_GELEM] = so_ck_gelem;
}
#if SO_THREADSAFE
HV *map;
CV *placeholder;
tTHX owner;
-CODE:
+PPCODE:
{
dMY_CXT;
owner = MY_CXT.owner;
{
MY_CXT_CLONE;
MY_CXT.map = map;
- MY_CXT.next_pkg = newAV();
- MY_CXT.next_name = newAV();
MY_CXT.placeholder = placeholder;
MY_CXT.owner = aTHX;
}
+ XSRETURN(0);
#endif /* SO_THREADSAFE */
PROTOTYPE: $
PREINIT:
OP *o;
- sub_op_name_t *on;
+ so_op_name_t *on;
PPCODE:
if (!SvROK(op))
XSRETURN_UNDEF;
if (!o || o->op_type != OP_CUSTOM)
XSRETURN_UNDEF;
#ifdef USE_ITHREADS
- MUTEX_LOCK(&sub_op_name_mutex);
+ MUTEX_LOCK(&so_op_name_mutex);
#endif /* USE_ITHREADS */
- on = ptable_fetch(sub_op_name, o);
+ on = ptable_fetch(so_op_name, o);
#ifdef USE_ITHREADS
- MUTEX_UNLOCK(&sub_op_name_mutex);
+ MUTEX_UNLOCK(&so_op_name_mutex);
#endif /* USE_ITHREADS */
if (!on)
XSRETURN_UNDEF;
ST(0) = sv_2mortal(newSVpvn(&on->buf, on->len));
XSRETURN(1);
+
+void
+_constant_sub(SV *sv)
+PROTOTYPE: $
+PPCODE:
+ if (!SvROK(sv))
+ XSRETURN_UNDEF;
+ sv = SvRV(sv);
+ if (SvTYPE(sv) < SVt_PVCV)
+ XSRETURN_UNDEF;
+ ST(0) = sv_2mortal(newSVuv(CvCONST(sv)));
+ XSRETURN(1);