cvs commit: ponie/perl embedvar.h perl.c perlapi.h perlvars.h sv.c sv.h util.c
[email protected] (Nicholas Clark) 26 Oct 2004 18:50:25 -0000
| Newsgroups | perl.ponie.changes |
|---|---|
| Message-ID | <[email protected]> |
cvsuser 04/10/26 11:50:25
Modified: perl embedvar.h perl.c perlapi.h perlvars.h sv.c sv.h
util.c
Log:
Do the PMC type name to number lookup once, up front, rather than every
time we create an SV. (Should save several thousand cstring_to_string
conversions, lots of GC, and general unnecessary profligate resource use)
Revision Changes Path
1.8 +4 -0 ponie/perl/embedvar.h
Index: embedvar.h
===================================================================
RCS file: /cvs/public/ponie/perl/embedvar.h,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- embedvar.h 23 Jun 2004 10:54:24 -0000 1.7
+++ embedvar.h 26 Oct 2004 18:50:24 -0000 1.8
@@ -898,6 +898,8 @@
#define PL_malloc_mutex (PL_Vars.Gmalloc_mutex)
#define PL_op_mutex (PL_Vars.Gop_mutex)
#define PL_patleave (PL_Vars.Gpatleave)
+#define PL_pmcname (PL_Vars.Gpmcname)
+#define PL_pmcname_mutex (PL_Vars.Gpmcname_mutex)
#define PL_sh_path (PL_Vars.Gsh_path)
#define PL_sigfpe_saved (PL_Vars.Gsigfpe_saved)
#define PL_thr_key (PL_Vars.Gthr_key)
@@ -914,6 +916,8 @@
#define PL_Gmalloc_mutex PL_malloc_mutex
#define PL_Gop_mutex PL_op_mutex
#define PL_Gpatleave PL_patleave
+#define PL_Gpmcname PL_pmcname
+#define PL_Gpmcname_mutex PL_pmcname_mutex
#define PL_Gsh_path PL_sh_path
#define PL_Gsigfpe_saved PL_sigfpe_saved
#define PL_Gthr_key PL_thr_key
1.14 +40 -0 ponie/perl/perl.c
Index: perl.c
===================================================================
RCS file: /cvs/public/ponie/perl/perl.c,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- perl.c 15 Oct 2004 16:58:04 -0000 1.13
+++ perl.c 26 Oct 2004 18:50:24 -0000 1.14
@@ -69,6 +69,7 @@
PERL_SET_THX(my_perl); \
OP_REFCNT_INIT; \
MUTEX_INIT(&PL_dollarzero_mutex); \
+ MUTEX_INIT(&PL_pmcname_mutex); \
} \
else { \
PERL_SET_THX(my_perl); \
@@ -150,6 +151,16 @@
Parrot_PMC (*)(Parrot_INTERP),
void (*)(Parrot_INTERP, Parrot_PMC));
+typedef struct {
+ int array_index;
+ const char *name;
+} Ponie_pmc_init;
+
+#define PONIE_PMC_INIT(a) {CAT2(Ponie_PMC_Perl5_,a), "Perl5" STRINGIFY(a)}
+/* So PONIE_PMC_INIT(PVMG) goes to
+ {Ponie_PMC_Perl5_PVMG, "Perl5PVMG"},\
+*/
+
void
perl_construct(pTHXx)
{
@@ -162,6 +173,35 @@
Parrot_init_lib(PL_Parrot, &Parrot_lib_perl5pmcs_load, NULL);
+#ifdef USE_ITHREADS
+ MUTEX_LOCK(&PL_pmcname_mutex);
+#endif
+ if (PL_pmcname[Ponie_PMC_ZERO] == 0) {
+ const static Ponie_pmc_init s[] =
+ {
+ {Ponie_PMC_Perl5_NULL, "Perl5NULL"},
+ PONIE_PMC_INIT (PVMG),
+ {Ponie_PMC_Perl5_MAX, NULL}
+ };
+ const Ponie_pmc_init *i = s;
+ while (i->name) {
+ Parrot_Int type = Parrot_PMC_typenum(PL_Parrot, i->name);
+
+ if (!type) {
+ const char *bail = "Could not find PMC type '";
+ write(2, bail, strlen(bail) + 1);
+ write(2, i->name, strlen(i->name));
+ write(2, "'\n", 2);
+ abort();
+ }
+ PL_pmcname[i->array_index] = type;
+ ++i;
+ }
+ }
+#ifdef USE_ITHREADS
+ MUTEX_UNLOCK(&PL_pmcname_mutex);
+#endif
+
PL_sv_arenatable = Perl_ptr_table_new(aTHX);
#ifdef MULTIPLICITY
1.8 +4 -0 ponie/perl/perlapi.h
Index: perlapi.h
===================================================================
RCS file: /cvs/public/ponie/perl/perlapi.h,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- perlapi.h 23 Jun 2004 10:54:24 -0000 1.7
+++ perlapi.h 26 Oct 2004 18:50:24 -0000 1.8
@@ -940,6 +940,10 @@
#define PL_op_mutex (*Perl_Gop_mutex_ptr(NULL))
#undef PL_patleave
#define PL_patleave (*Perl_Gpatleave_ptr(NULL))
+#undef PL_pmcname
+#define PL_pmcname (*Perl_Gpmcname_ptr(NULL))
+#undef PL_pmcname_mutex
+#define PL_pmcname_mutex (*Perl_Gpmcname_mutex_ptr(NULL))
#undef PL_sh_path
#define PL_sh_path (*Perl_Gsh_path_ptr(NULL))
#undef PL_sigfpe_saved
1.3 +7 -0 ponie/perl/perlvars.h
Index: perlvars.h
===================================================================
RCS file: /cvs/public/ponie/perl/perlvars.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- perlvars.h 21 Jun 2004 12:09:22 -0000 1.2
+++ perlvars.h 26 Oct 2004 18:50:24 -0000 1.3
@@ -65,3 +65,10 @@
PERLVARI(Gcsighandlerp, Sighandler_t, &Perl_csighandler) /* Pointer to C-level sighandler */
#endif
+#ifdef USE_ITHREADS
+PERLVAR(Gpmcname_mutex, perl_mutex) /* Initialising it */
+#endif
+
+/* Cached names for PMC types */
+PERLVARI(Gpmcname[Ponie_PMC_Perl5_MAX], Parrot_Int, {0})
+
1.47 +1 -2 ponie/perl/sv.c
Index: sv.c
===================================================================
RCS file: /cvs/public/ponie/perl/sv.c,v
retrieving revision 1.46
retrieving revision 1.47
diff -u -r1.46 -r1.47
--- sv.c 16 Oct 2004 19:04:22 -0000 1.46
+++ sv.c 26 Oct 2004 18:50:24 -0000 1.47
@@ -161,8 +161,7 @@
STATIC SV*
S_new_SV(pTHX)
{
- Parrot_Int type = Parrot_PMC_typenum(PL_Parrot, "Perl5NULL");
- Parrot_PMC sv = Parrot_PMC_new(PL_Parrot, type);
+ Parrot_PMC sv = Parrot_PMC_new(PL_Parrot, PL_pmcname[Ponie_PMC_Perl5_NULL]);
Parrot_register_pmc(PL_Parrot, sv);
sv = MUMBLE(sv);
LOCK_SV_MUTEX;
1.50 +7 -0 ponie/perl/sv.h
Index: sv.h
===================================================================
RCS file: /cvs/public/ponie/perl/sv.h,v
retrieving revision 1.49
retrieving revision 1.50
diff -u -r1.49 -r1.50
--- sv.h 16 Oct 2004 22:31:39 -0000 1.49
+++ sv.h 26 Oct 2004 18:50:24 -0000 1.50
@@ -183,6 +183,13 @@
/* All the things get_pointer_keyed_int can return. */
typedef enum {
+ Ponie_PMC_ZERO = 0,
+ Ponie_PMC_Perl5_NULL = 0,
+ Ponie_PMC_Perl5_PVMG,
+ Ponie_PMC_Perl5_MAX
+} Ponie_pmcs;
+
+typedef enum {
Ponie_P_ANY, /* SvANY pointer */
Ponie_P_RV, /* SvRV pointer */
Ponie_P_IVX, /* SvIVX pointer */
1.8 +1 -3 ponie/perl/util.c
Index: util.c
===================================================================
RCS file: /cvs/public/ponie/perl/util.c,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- util.c 16 Oct 2004 07:59:37 -0000 1.7
+++ util.c 26 Oct 2004 18:50:24 -0000 1.8
@@ -817,7 +817,6 @@
S_mess_alloc(pTHX)
{
SV *sv;
- Parrot_Int type;
Parrot_PMC pvpvmg;
XPVMG *any;
@@ -829,8 +828,7 @@
/* Create as PVMG now, to avoid any upgrading later */
- type = Parrot_PMC_typenum(PL_Parrot, "Perl5PVMG");
- pvpvmg = Parrot_PMC_new(PL_Parrot, type);
+ pvpvmg = Parrot_PMC_new(PL_Parrot, PL_pmcname[Ponie_PMC_Perl5_PVMG]);
Parrot_register_pmc(PL_Parrot, pvpvmg);
sv = MUMBLE(pvpvmg);