cvs commit: modperl-2.0/src/modules/perl modperl_perl_global.c modperl_perl_global.h
dougm 01/10/13 11:55:03
Modified:src/modules/perl modperl_perl_global.c modperl_perl_global.h
Log:
s/hv_fetch/hv_fetch_he/g
Revision ChangesPath
1.10 +24 -9 modperl-2.0/src/modules/perl/modperl_perl_global.c
Index: modperl_perl_global.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl_global.c,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- modperl_perl_global.c 2001/10/08 21:09:08 1.9
+++ modperl_perl_global.c 2001/10/13 18:55:03 1.10
@@ -12,8 +12,14 @@
/* XXX: PL_modglobal thingers might be useful elsewhere */
+#define MP_MODGLOBAL_FETCH(gkey) \
+hv_fetch_he(PL_modglobal, (char *)gkey-val, gkey-len, gkey-hash)
+
+#define MP_MODGLOBAL_STORE_HV(gkey) \
+(HV*)*hv_store(PL_modglobal, gkey-val, gkey-len, (SV*)newHV(), gkey-hash)
+
#define MP_MODGLOBAL_ENT(key) \
-{key, ModPerl:: key, (sizeof(ModPerl::)-1)+(sizeof(key)-1)}
+{key, ModPerl:: key, (sizeof(ModPerl::)-1)+(sizeof(key)-1), 0}
static modperl_modglobal_key_t MP_modglobal_keys[] = {
MP_MODGLOBAL_ENT(END),
@@ -36,18 +42,18 @@
static AV *modperl_perl_global_avcv_fetch(pTHX_ modperl_modglobal_key_t *gkey,
const char *package, I32 packlen)
{
-SV **svp = hv_fetch(PL_modglobal, gkey-val, gkey-len, FALSE);
+HE *he = MP_MODGLOBAL_FETCH(gkey);
HV *hv;
-if (!(svp (hv = (HV*)*svp))) {
+if (!(he (hv = (HV*)HeVAL(he {
return Nullav;
}
-if (!(svp = hv_fetch(hv, package, packlen, FALSE))) {
+if (!(he = hv_fetch_he(hv, (char *)package, packlen, 0))) {
return Nullav;
}
-return (AV*)*svp;
+return (AV*)HeVAL(he);
}
void modperl_perl_global_avcv_call(pTHX_ modperl_modglobal_key_t *gkey,
@@ -76,6 +82,7 @@
static int modperl_perl_global_avcv_set(pTHX_ SV *sv, MAGIC *mg)
{
+HE *he;
HV *hv;
AV *mav, *av = (AV*)sv;
const char *package = HvNAME(PL_curstash);
@@ -83,11 +90,19 @@
modperl_modglobal_key_t *gkey =
(modperl_modglobal_key_t *)mg-mg_ptr;
-hv = (HV*)*hv_fetch(PL_modglobal, gkey-val, gkey-len, TRUE);
-(void)SvUPGRADE((SV*)hv, SVt_PVHV);
+if ((he = MP_MODGLOBAL_FETCH(gkey))) {
+hv = (HV*)HeVAL(he);
+}
+else {
+hv = MP_MODGLOBAL_STORE_HV(gkey);
+}
-mav = (AV*)*hv_fetch(hv, package, packlen, TRUE);
-(void)SvUPGRADE((SV*)mav, SVt_PVAV);
+if ((he = hv_fetch_he(hv, (char *)package, packlen, 0))) {
+mav = (AV*)HeVAL(he);
+}
+else {
+mav = (AV*)*hv_store(hv, package, packlen, (SV*)newAV(), 0);
+}
/* $cv = pop @av */
sv = AvARRAY(av)[AvFILLp(av)];
1.8 +1 -0 modperl-2.0/src/modules/perl/modperl_perl_global.h
Index: modperl_perl_global.h
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl_global.h,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- modperl_perl_global.h 2001/10/07 22:07:15 1.7
+++ modperl_perl_global.h 2001/10/13 18:55:03 1.8
@@ -5,6 +5,7 @@
const char *name;
const char *val;
I32 len;
+U32 hash;
} modperl_modglobal_key_t;
typedef enum {
cvs commit: modperl-2.0/src/modules/perl modperl_perl_global.c
dougm 01/10/13 12:05:16
Modified:src/modules/perl modperl_perl_global.c
Log:
use consistent style to iterate over MP_modglobal_keys
Revision ChangesPath
1.12 +5 -4 modperl-2.0/src/modules/perl/modperl_perl_global.c
Index: modperl_perl_global.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl_global.c,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- modperl_perl_global.c 2001/10/13 19:02:03 1.11
+++ modperl_perl_global.c 2001/10/13 19:05:16 1.12
@@ -38,12 +38,13 @@
modperl_modglobal_key_t *modperl_modglobal_lookup(pTHX_ const char *name)
{
-int i;
+modperl_modglobal_key_t *gkey = MP_modglobal_keys;
-for (i=0; MP_modglobal_keys[i].name; i++) {
-if (strEQ(MP_modglobal_keys[i].name, name)) {
-return MP_modglobal_keys[i];
+while (gkey-name) {
+if (strEQ(gkey-name, name)) {
+return gkey;
}
+gkey++;
}
return NULL;
cvs commit: modperl-2.0/src/modules/perl modperl_perl_global.c modperl_perl_global.h
dougm 01/10/07 14:59:16
Modified:src/modules/perl modperl_perl_global.c modperl_perl_global.h
Log:
implement logic for saving Perl special subroutines (END,BEGIN,CHECK,INIT)
into the per-interpreter PL_modglobal hash
modperl_perl_global_avcv_call() function to call the subroutines for given
package
modperl_perl_global_avcv_clear() function to clear the subroutines for given
package
END blocks are now saved via the new logic
Revision ChangesPath
1.6 +130 -0modperl-2.0/src/modules/perl/modperl_perl_global.c
Index: modperl_perl_global.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl_global.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- modperl_perl_global.c 2001/10/07 19:04:20 1.5
+++ modperl_perl_global.c 2001/10/07 21:59:16 1.6
@@ -6,9 +6,131 @@
globals-inc.gv= PL_incgv;
globals-defout.gv = PL_defoutgv;
globals-rs.sv = PL_rs;
+globals-end.av= PL_endav;
+globals-end.key = MP_MODGLOBAL_END;
}
+/* XXX: PL_modglobal thingers might be useful elsewhere */
+
+#define MP_MODGLOBAL_ENT(key) \
+{key, ModPerl:: key, (sizeof(ModPerl::)-1)+(sizeof(key)-1), 0}
+
+static modperl_modglobal_key_t MP_modglobal_keys[] = {
+MP_MODGLOBAL_ENT(END),
+};
+
+static AV *modperl_perl_global_avcv_fetch(pTHX_ modperl_modglobal_key_t *gkey,
+ const char *package, I32 packlen)
+{
+SV **svp = hv_fetch(PL_modglobal, gkey-val, gkey-len, FALSE);
+HV *hv;
+
+if (!(svp (hv = (HV*)*svp))) {
+return Nullav;
+}
+
+if (!(svp = hv_fetch(hv, package, packlen, FALSE))) {
+return Nullav;
+}
+
+return (AV*)*svp;
+}
+
+void modperl_perl_global_avcv_call(pTHX_ modperl_modglobal_key_t *gkey,
+ const char *package, I32 packlen)
+{
+AV *av = modperl_perl_global_avcv_fetch(aTHX_ gkey, package, packlen);
+
+if (!av) {
+return;
+}
+
+modperl_perl_call_list(aTHX_ av, gkey-name);
+}
+
+void modperl_perl_global_avcv_clear(pTHX_ modperl_modglobal_key_t *gkey,
+const char *package, I32 packlen)
+{
+AV *av = modperl_perl_global_avcv_fetch(aTHX_ gkey, package, packlen);
+
+if (!av) {
+return;
+}
+
+av_clear(av);
+}
+
+static int modperl_perl_global_avcv_set(pTHX_ SV *sv, MAGIC *mg)
+{
+HV *hv;
+AV *mav, *av = (AV*)sv;
+const char *package = HvNAME(PL_curstash);
+I32 packlen = strlen(package);
+modperl_modglobal_key_t *gkey =
+(modperl_modglobal_key_t *)mg-mg_ptr;
+
+hv = (HV*)*hv_fetch(PL_modglobal, gkey-val, gkey-len, TRUE);
+(void)SvUPGRADE((SV*)hv, SVt_PVHV);
+
+mav = (AV*)*hv_fetch(hv, package, packlen, TRUE);
+(void)SvUPGRADE((SV*)mav, SVt_PVAV);
+
+/* $cv = pop @av */
+sv = AvARRAY(av)[AvFILLp(av)];
+AvARRAY(av)[AvFILLp(av)--] = PL_sv_undef;
+
+/* push @{ $PL_modglobal{$key}{$package} }, $cv */
+av_store(mav, AvFILLp(av)+1, sv);
+
+return 1;
+}
+
+static MGVTBL modperl_vtbl_global_avcv_t = {
+0,
+MEMBER_TO_FPTR(modperl_perl_global_avcv_set),
+0, 0, 0,
+};
+
+/* XXX: Apache::RegistryLoader type things need access to this
+ * for compiling scripts at startup
+ */
+static void modperl_perl_global_avcv_tie(pTHX_ modperl_modglobal_key_e key,
+ AV *av)
+{
+if (!SvMAGIC((SV*)av)) {
+MAGIC *mg;
+Newz(702, mg, 1, MAGIC);
+mg-mg_virtual = modperl_vtbl_global_avcv_t;
+mg-mg_ptr = (char *)MP_modglobal_keys[key];
+mg-mg_len = -1; /* prevent free() of mg-mg_ptr */
+SvMAGIC((SV*)av) = mg;
+}
+
+SvSMAGICAL_on((SV*)av);
+}
+
+static void modperl_perl_global_avcv_untie(pTHX_ AV *av)
+{
+SvSMAGICAL_off((SV*)av);
+}
+
+static void
+modperl_perl_global_avcv_save(pTHX_ modperl_perl_global_avcv_t *avcv)
+{
+avcv-origav = *avcv-av;
+*avcv-av = newAV(); /* XXX: only need 1 of these AVs per-interpreter */
+modperl_perl_global_avcv_tie(aTHX_ avcv-key, *avcv-av);
+}
+
static void
+modperl_perl_global_avcv_restore(pTHX_ modperl_perl_global_avcv_t *avcv)
+{
+modperl_perl_global_avcv_untie(aTHX_ *avcv-av);
+SvREFCNT_dec(*avcv-av); /* XXX: see XXX above */
+*avcv-av = avcv-origav;
+}
+
+static void
modperl_perl_global_gvhv_save(pTHX_ modperl_perl_global_gvhv_t *gvhv)
{
U32 mg_flags;
@@ -93,6 +215,7 @@
}
typedef enum {
+MP_GLOBAL_AVCV,
MP_GLOBAL_GVHV,
MP_GLOBAL_GVAV,
MP_GLOBAL_GVIO,
@@ -109,6 +232,7 @@
cvs commit: modperl-2.0/src/modules/perl modperl_perl_global.c modperl_perl_global.h
dougm 01/10/07 15:04:07
Modified:src/modules/perl modperl_perl_global.c modperl_perl_global.h
Log:
add modperl_modglobal_lookup() function to lookup a modperl_modglobal_key_t based on
string name
Revision ChangesPath
1.7 +14 -0 modperl-2.0/src/modules/perl/modperl_perl_global.c
Index: modperl_perl_global.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl_global.c,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- modperl_perl_global.c 2001/10/07 21:59:16 1.6
+++ modperl_perl_global.c 2001/10/07 22:04:07 1.7
@@ -17,7 +17,21 @@
static modperl_modglobal_key_t MP_modglobal_keys[] = {
MP_MODGLOBAL_ENT(END),
+{ NULL },
};
+
+modperl_modglobal_key_t *modperl_modglobal_lookup(pTHX_ const char *name)
+{
+int i;
+
+for (i=0; MP_modglobal_keys[i].name; i++) {
+if (strEQ(MP_modglobal_keys[i].name, name)) {
+return MP_modglobal_keys[i];
+}
+}
+
+return NULL;
+}
static AV *modperl_perl_global_avcv_fetch(pTHX_ modperl_modglobal_key_t *gkey,
const char *package, I32 packlen)
1.6 +2 -0 modperl-2.0/src/modules/perl/modperl_perl_global.h
Index: modperl_perl_global.h
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl_global.h,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- modperl_perl_global.h 2001/10/07 21:59:16 1.5
+++ modperl_perl_global.h 2001/10/07 22:04:07 1.6
@@ -49,6 +49,8 @@
modperl_perl_global_svpv_t rs;
} modperl_perl_globals_t;
+modperl_modglobal_key_t *modperl_modglobal_lookup(pTHX_ const char *name);
+
void modperl_perl_global_request_save(pTHX_ request_rec *r);
void modperl_perl_global_request_restore(pTHX_ request_rec *r);
cvs commit: modperl-2.0/src/modules/perl modperl_perl_global.c modperl_perl_global.h
dougm 01/10/07 15:07:15
Modified:src/modules/perl modperl_perl_global.c modperl_perl_global.h
Log:
wont be able to use a precomputed hash for modperl_modglobal_key_t's
Revision ChangesPath
1.8 +1 -1 modperl-2.0/src/modules/perl/modperl_perl_global.c
Index: modperl_perl_global.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl_global.c,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- modperl_perl_global.c 2001/10/07 22:04:07 1.7
+++ modperl_perl_global.c 2001/10/07 22:07:15 1.8
@@ -13,7 +13,7 @@
/* XXX: PL_modglobal thingers might be useful elsewhere */
#define MP_MODGLOBAL_ENT(key) \
-{key, ModPerl:: key, (sizeof(ModPerl::)-1)+(sizeof(key)-1), 0}
+{key, ModPerl:: key, (sizeof(ModPerl::)-1)+(sizeof(key)-1)}
static modperl_modglobal_key_t MP_modglobal_keys[] = {
MP_MODGLOBAL_ENT(END),
1.7 +0 -1 modperl-2.0/src/modules/perl/modperl_perl_global.h
Index: modperl_perl_global.h
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl_global.h,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- modperl_perl_global.h 2001/10/07 22:04:07 1.6
+++ modperl_perl_global.h 2001/10/07 22:07:15 1.7
@@ -5,7 +5,6 @@
const char *name;
const char *val;
I32 len;
-U32 hash;
} modperl_modglobal_key_t;
typedef enum {
cvs commit: modperl-2.0/src/modules/perl modperl_perl_global.c modperl_perl_global.h modperl_util.h
dougm 01/09/28 12:24:44
Modified:src/modules/perl modperl_perl_global.c modperl_perl_global.h
modperl_util.h
Log:
add save/restore of %ENV to Perl global management
Revision ChangesPath
1.2 +52 -0 modperl-2.0/src/modules/perl/modperl_perl_global.c
Index: modperl_perl_global.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl_global.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- modperl_perl_global.c 2001/09/27 19:03:19 1.1
+++ modperl_perl_global.c 2001/09/28 19:24:44 1.2
@@ -2,12 +2,56 @@
static void modperl_perl_global_init(pTHX_ modperl_perl_globals_t *globals)
{
+globals-env.gv= PL_envgv;
globals-inc.gv= PL_incgv;
globals-defout.gv = PL_defoutgv;
globals-rs.sv = PL_rs;
}
static void
+modperl_perl_global_gvhv_save(pTHX_ modperl_perl_global_gvhv_t *gvhv)
+{
+U32 mg_flags;
+HV *hv = GvHV(gvhv-gv);
+
+/*
+ * there should only be a small number of entries in %ENV
+ * at this point: modperl_env.c:modperl_env_const_vars[],
+ * PerlPassEnv and top-level PerlSetEnv
+ * XXX: still; could have have something faster than newHVhv()
+ * especially if we add another GVHV to the globals table that
+ * might have more entries
+ */
+
+/* makes newHVhv() faster in bleedperl */
+MP_magical_untie(hv, mg_flags);
+
+gvhv-tmphv = newHVhv(hv);
+TAINT_NOT;
+
+/* reapply magic flags */
+MP_magical_tie(hv, mg_flags);
+MP_magical_tie(gvhv-tmphv, mg_flags);
+
+gvhv-orighv = hv;
+GvHV(gvhv-gv) = gvhv-tmphv;
+}
+
+static void
+modperl_perl_global_gvhv_restore(pTHX_ modperl_perl_global_gvhv_t *gvhv)
+{
+U32 mg_flags;
+
+GvHV(gvhv-gv) = gvhv-orighv;
+
+/* loose magic for hv_clear()
+ * e.g. for %ENV don't want to clear environ array
+ */
+MP_magical_untie(gvhv-tmphv, mg_flags);
+SvREFCNT_dec(gvhv-tmphv);
+}
+
+static void
modperl_perl_global_gvav_save(pTHX_ modperl_perl_global_gvav_t *gvav)
{
AV *av = GvAV(gvav-gv);
@@ -59,6 +103,7 @@
}
typedef enum {
+MP_GLOBAL_GVHV,
MP_GLOBAL_GVAV,
MP_GLOBAL_GVIO,
MP_GLOBAL_SVPV,
@@ -74,6 +119,7 @@
STRUCT_OFFSET(modperl_perl_globals_t, m)
static modperl_perl_global_entry_t modperl_perl_global_entries[] = {
+{ENV,MP_GLOBAL_OFFSET(env),MP_GLOBAL_GVHV}, /* %ENV */
{INC,MP_GLOBAL_OFFSET(inc),MP_GLOBAL_GVAV}, /* @INC */
{STDOUT, MP_GLOBAL_OFFSET(defout), MP_GLOBAL_GVIO}, /* $| */
{/, MP_GLOBAL_OFFSET(rs), MP_GLOBAL_SVPV}, /* $/ */
@@ -102,6 +148,9 @@
MP_dGLOBAL_PTR(globals, i);
switch (modperl_perl_global_entries[i].type) {
+ case MP_GLOBAL_GVHV:
+MP_PERL_GLOBAL_SAVE(gvhv, ptr);
+break;
case MP_GLOBAL_GVAV:
MP_PERL_GLOBAL_SAVE(gvav, ptr);
break;
@@ -123,6 +172,9 @@
MP_dGLOBAL_PTR(globals, i);
switch (modperl_perl_global_entries[i].type) {
+ case MP_GLOBAL_GVHV:
+MP_PERL_GLOBAL_RESTORE(gvhv, ptr);
+break;
case MP_GLOBAL_GVAV:
MP_PERL_GLOBAL_RESTORE(gvav, ptr);
break;
1.2 +7 -0 modperl-2.0/src/modules/perl/modperl_perl_global.h
Index: modperl_perl_global.h
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl_global.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- modperl_perl_global.h 2001/09/27 19:03:19 1.1
+++ modperl_perl_global.h 2001/09/28 19:24:44 1.2
@@ -9,6 +9,12 @@
typedef struct {
GV *gv;
+HV *tmphv;
+HV *orighv;
+} modperl_perl_global_gvhv_t;
+
+typedef struct {
+GV *gv;
char flags;
} modperl_perl_global_gvio_t;
@@ -19,6 +25,7 @@
} modperl_perl_global_svpv_t;
typedef struct {
+modperl_perl_global_gvhv_t env;
modperl_perl_global_gvav_t inc;
modperl_perl_global_gvio_t defout;
modperl_perl_global_svpv_t rs;
1.18 +7 -0 modperl-2.0/src/modules/perl/modperl_util.h
Index: modperl_util.h
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.h,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- modperl_util.h2001/09/25 19:44:02 1.17
+++ modperl_util.h2001/09/28 19:24:44 1.18
@@ -21,6 +21,13 @@
#define SvObjIV(o) SvIV((SV*)SvRV(o))
#define MgObjIV(m) SvIV((SV*)SvRV(m-mg_obj))
+#define
cvs commit: modperl-2.0/src/modules/perl modperl_perl_global.c modperl_perl_global.h
dougm 01/09/28 12:53:22
Modified:src/modules/perl modperl_perl_global.c modperl_perl_global.h
Log:
use the address of sv for modperl_perl_global_svpv_t, since it might point to a
different SV when restore happens
Revision ChangesPath
1.3 +4 -4 modperl-2.0/src/modules/perl/modperl_perl_global.c
Index: modperl_perl_global.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl_global.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- modperl_perl_global.c 2001/09/28 19:24:44 1.2
+++ modperl_perl_global.c 2001/09/28 19:53:22 1.3
@@ -5,7 +5,7 @@
globals-env.gv= PL_envgv;
globals-inc.gv= PL_incgv;
globals-defout.gv = PL_defoutgv;
-globals-rs.sv = PL_rs;
+globals-rs.sv = PL_rs;
}
static void
@@ -92,14 +92,14 @@
static void
modperl_perl_global_svpv_save(pTHX_ modperl_perl_global_svpv_t *svpv)
{
-svpv-cur = SvCUR(svpv-sv);
-strncpy(svpv-pv, SvPVX(svpv-sv), sizeof(svpv-pv));
+svpv-cur = SvCUR(*svpv-sv);
+strncpy(svpv-pv, SvPVX(*svpv-sv), sizeof(svpv-pv));
}
static void
modperl_perl_global_svpv_restore(pTHX_ modperl_perl_global_svpv_t *svpv)
{
-sv_setpvn(svpv-sv, svpv-pv, svpv-cur);
+sv_setpvn(*svpv-sv, svpv-pv, svpv-cur);
}
typedef enum {
1.3 +1 -1 modperl-2.0/src/modules/perl/modperl_perl_global.h
Index: modperl_perl_global.h
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl_global.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- modperl_perl_global.h 2001/09/28 19:24:44 1.2
+++ modperl_perl_global.h 2001/09/28 19:53:22 1.3
@@ -19,7 +19,7 @@
} modperl_perl_global_gvio_t;
typedef struct {
-SV *sv;
+SV **sv;
char pv[256]; /* XXX: only need enough for $/ at the moment */
I32 cur;
} modperl_perl_global_svpv_t;
