[svn:ponie] r395 - branches/5.9.3merge/perl
[email protected] Thu, 16 Mar 2006 14:07:56 -0800 (PST)
| Newsgroups | perl.ponie.changes |
|---|---|
| Message-ID | <[email protected]> |
Author: nicholas
Date: Thu Mar 16 14:07:54 2006
New Revision: 395
Modified:
branches/5.9.3merge/perl/av.h
branches/5.9.3merge/perl/dump.c
branches/5.9.3merge/perl/embed.fnc
branches/5.9.3merge/perl/embed.h
branches/5.9.3merge/perl/embedvar.h
branches/5.9.3merge/perl/global.sym
branches/5.9.3merge/perl/gv.h
branches/5.9.3merge/perl/handy.h
branches/5.9.3merge/perl/hv.c
branches/5.9.3merge/perl/hv.h
branches/5.9.3merge/perl/intrpvar.h
branches/5.9.3merge/perl/mg.c
branches/5.9.3merge/perl/op.c
branches/5.9.3merge/perl/pad.c
branches/5.9.3merge/perl/perl.c
branches/5.9.3merge/perl/perlapi.h
branches/5.9.3merge/perl/proto.h
branches/5.9.3merge/perl/sv.h
branches/5.9.3merge/perl/toke.c
Log:
Part of the way to getting the merge compiling.
Modified: branches/5.9.3merge/perl/av.h
==============================================================================
--- branches/5.9.3merge/perl/av.h (original)
+++ branches/5.9.3merge/perl/av.h Thu Mar 16 14:07:54 2006
@@ -79,9 +79,6 @@
#define AvREUSED_off(av) (AvFLAGS(av) &= ~AVf_REUSED)
#define AvREIFY_only(av) (AvREAL_off(av), AvFLAGS(av) |= AVf_REAL)
#define AvREALISH(av) (AvFLAGS(av) & (AVf_REAL|AVf_REIFY))
-
-
-#define AvREALISH(av) (SvFLAGS(av) & (SVpav_REAL|SVpav_REIFY))
#define AvFILL(av) ((SvRMAGICAL((SV *) (av))) \
? mg_size((SV *) av) : AvFILLp(av))
Modified: branches/5.9.3merge/perl/dump.c
==============================================================================
--- branches/5.9.3merge/perl/dump.c (original)
+++ branches/5.9.3merge/perl/dump.c Thu Mar 16 14:07:54 2006
@@ -1445,15 +1445,6 @@
if (hvname)
Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", hvname);
}
- if (SvOOK(sv)) {
- AV *backrefs = *Perl_hv_backreferences_p(aTHX_ (HV*)sv);
- if (backrefs) {
- Perl_dump_indent(aTHX_ level, file, " BACKREFS = 0x%"UVxf"\n",
- PTR2UV(backrefs));
- do_sv_dump(level+1, file, (SV*)backrefs, nest+1, maxnest,
- dumpops, pvlim);
- }
- }
if (nest < maxnest && !HvEITER_get(sv)) { /* Try to preserve iterator */
HE *he;
HV * const hv = (HV*)sv;
Modified: branches/5.9.3merge/perl/embed.fnc
==============================================================================
--- branches/5.9.3merge/perl/embed.fnc (original)
+++ branches/5.9.3merge/perl/embed.fnc Thu Mar 16 14:07:54 2006
@@ -738,6 +738,12 @@
Amb |IV |sv_2iv |NN SV* sv
Apd |IV |sv_2iv_flags |NN SV* sv|I32 flags
Apd |SV* |sv_2mortal |NULLOK SV* sv
+#if defined(PERL_CORE) || defined(PONIE_CORE)
+po |IV |sv_2iv_backend |SV* sv|I32 flags
+po |UV |sv_2uv_backend |SV* sv|I32 flags
+po |NV |sv_2nv_backend |SV* sv
+po |char* |sv_2pv_backend |SV* sv|STRLEN* lp|I32 flags
+#endif
Apd |NV |sv_2nv |NN SV* sv
Amb |char* |sv_2pv |NN SV* sv|NULLOK STRLEN* lp
Apd |char* |sv_2pv_flags |NN SV* sv|NULLOK STRLEN* lp|I32 flags
@@ -765,6 +771,7 @@
pd |I32 |sv_clean_all
pd |void |sv_clean_objs
Apd |void |sv_clear |NN SV* sv
+Apd |void |sv_clear_backend|SV* sv|I32 flags
Apd |I32 |sv_cmp |NN SV* sv1|NN SV* sv2
Apd |I32 |sv_cmp_locale |NN SV* sv1|NN SV* sv2
#if defined(USE_LOCALE_COLLATE)
@@ -778,6 +785,7 @@
Apd |I32 |sv_eq |NULLOK SV* sv1|NULLOK SV* sv2
Apd |void |sv_free |NULLOK SV* sv
poMX |void |sv_free2 |NN SV* sv
+poMX |void |sv_free_immortal|SV* sv
pd |void |sv_free_arenas
Apd |char* |sv_gets |NN SV* sv|NN PerlIO* fp|I32 append
Apd |char* |sv_grow |NN SV* sv|STRLEN newlen
@@ -807,6 +815,11 @@
ApdR |char* |sv_reftype |NN const SV* sv|int ob
Apd |void |sv_replace |NN SV* sv|NN SV* nsv
Apd |void |sv_report_used
+#if defined(PERL_CORE) || defined(PONIE_CORE)
+po |void |sv_setnv_backend |SV* sv|NV num|I32 flags
+po |void |sv_setiv_backend |SV* sv|UV num|I32 flags
+po |void |sv_setpvn_backend|SV* sv|const char* ptr|STRLEN len|I32 flags
+#endif
Apd |void |sv_reset |NN const char* s|NULLOK HV* stash
Afpd |void |sv_setpvf |NN SV* sv|NN const char* pat|...
Apd |void |sv_vsetpvf |NN SV* sv|NN const char* pat|NULLOK va_list* args
@@ -1025,6 +1038,10 @@
Adpbm |void |sv_nounlocking |NULLOK SV *sv
Adp |int |nothreadhook
+#if defined(PERL_IN_GV_C) || defined(PERL_IN_SV_C) || defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT)
+po |void |sv_add_backref |SV *tsv|SV *sv
+#endif
+
END_EXTERN_C
#if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT)
@@ -1044,13 +1061,14 @@
#if defined(PERL_IN_HV_C) || defined(PERL_DECL_PROT)
s |void |hsplit |NN HV *hv
s |void |hfreeentries |NN HV *hv
-sa |HE* |new_he
+s |void |more_he
+s |HE* |new_he
+s |void |del_he |HE *p
sa |HEK* |save_hek_flags |NN const char *str|I32 len|U32 hash|int flags
s |void |hv_magic_check |NN HV *hv|NN bool *needs_copy|NN bool *needs_store
s |void |unshare_hek_or_pvn|NULLOK const HEK* hek|NULLOK const char* str|I32 len|U32 hash
sR |HEK* |share_hek_flags|NN const char* sv|I32 len|U32 hash|int flags
rs |void |hv_notallowed |int flags|NN const char *key|I32 klen|NN const char *msg
-s |struct xpvhv_aux*|hv_auxinit|NN HV *hv
sM |SV* |hv_delete_common|NULLOK HV* tb|NULLOK SV* keysv|NULLOK const char* key \
|STRLEN klen|int k_flags|I32 d_flags|U32 hash
sM |HE* |hv_fetch_common|NULLOK HV* tb|NULLOK SV* keysv|NULLOK const char* key \
@@ -1319,15 +1337,10 @@
#if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT)
nsR |char * |uiv_2buf |NN char *buf|IV iv|UV uv|int is_uv|NN char **peob
-s |void |sv_unglob |NN SV* sv
s |void |not_a_number |NN SV *sv
s |I32 |visit |NN SVFUNC_t f|U32 flags|U32 mask
-s |void |sv_del_backref |NN SV *target|NN SV *ref
sR |SV * |varname |NULLOK GV *gv|const char gvtype|PADOFFSET targ \
|NULLOK SV *keyname|I32 aindex|int subscript_type
-# ifdef DEBUGGING
-s |void |del_sv |NN SV *p
-# endif
# if !defined(NV_PRESERVES_UV)
s |int |sv_2iuv_non_preserve |NN SV *sv|I32 numtype
# endif
@@ -1506,22 +1519,27 @@
pR |int |get_debug_opts |NN const char **s|bool givehelp
#endif
Ap |void |save_set_svflags|NULLOK SV* sv|U32 mask|U32 val
+Ap |void |save_set_padstale|SV* sv|
Apod |void |hv_assert |NN HV* tb
ApdR |SV* |hv_scalar |NN HV* hv
+#ifdef NOT_YET
ApoR |I32* |hv_riter_p |NN HV* hv
ApoR |HE** |hv_eiter_p |NN HV* hv
Apo |void |hv_riter_set |NN HV* hv|I32 riter
Apo |void |hv_eiter_set |NN HV* hv|NULLOK HE* eiter
Ap |void |hv_name_set |NN HV* hv|NULLOK const char *name|I32 len|int flags
poM |AV** |hv_backreferences_p |NN HV* hv
+#endif
#if defined(PERL_IN_DUMP_C) || defined(PERL_IN_HV_C) || defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT)
poM |void |hv_kill_backrefs |NN HV* hv
#endif
Apd |void |hv_clear_placeholders |NN HV* hb
+#if 0
ApoR |I32* |hv_placeholders_p |NN HV* hv
ApoR |I32 |hv_placeholders_get |NN HV* hv
Apo |void |hv_placeholders_set |NN HV* hv|I32 ph
+#endif
p |SV* |magic_scalarpack|NN HV* hv|NN MAGIC* mg
#ifdef PERL_IN_SV_C
@@ -1642,7 +1660,6 @@
po |void |sv_setpvn_backend|SV* sv|const char* ptr|STRLEN len|I32 flags
#endif
-
END_EXTERN_C
/*
* ex: set ts=8 sts=4 sw=4 noet:
Modified: branches/5.9.3merge/perl/embed.h
==============================================================================
--- branches/5.9.3merge/perl/embed.h (original)
+++ branches/5.9.3merge/perl/embed.h Thu Mar 16 14:07:54 2006
@@ -1010,6 +1010,15 @@
#define mg_dup Perl_mg_dup
#define sv_dup Perl_sv_dup
#define rvpv_dup Perl_rvpv_dup
+#define ptr_table_new Perl_ptr_table_new
+#define ptr_table_fetch Perl_ptr_table_fetch
+#define ptr_table_store Perl_ptr_table_store
+#define ptr_table_split Perl_ptr_table_split
+#define ptr_table_clear Perl_ptr_table_clear
+#define ptr_table_free Perl_ptr_table_free
+# if defined(HAVE_INTERP_INTERN)
+#define sys_intern_dup Perl_sys_intern_dup
+# endif
#endif
#define ptr_table_new Perl_ptr_table_new
#define ptr_table_delete Perl_ptr_table_delete
@@ -1021,10 +1030,6 @@
#define ptr_table_split Perl_ptr_table_split
#define ptr_table_clear Perl_ptr_table_clear
#define ptr_table_free Perl_ptr_table_free
-# if defined(HAVE_INTERP_INTERN)
-#define sys_intern_dup Perl_sys_intern_dup
-# endif
-#endif
#if defined(HAVE_INTERP_INTERN)
#define sys_intern_clear Perl_sys_intern_clear
#define sys_intern_init Perl_sys_intern_init
@@ -1038,6 +1043,8 @@
#endif
#define sv_nosharing Perl_sv_nosharing
#define nothreadhook Perl_nothreadhook
+#if defined(PERL_IN_GV_C) || defined(PERL_IN_SV_C) || defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT)
+#endif
#if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT)
#ifdef PERL_CORE
#define do_trans_simple S_do_trans_simple
@@ -1058,13 +1065,14 @@
#ifdef PERL_CORE
#define hsplit S_hsplit
#define hfreeentries S_hfreeentries
+#define more_he S_more_he
#define new_he S_new_he
+#define del_he S_del_he
#define save_hek_flags S_save_hek_flags
#define hv_magic_check S_hv_magic_check
#define unshare_hek_or_pvn S_unshare_hek_or_pvn
#define share_hek_flags S_share_hek_flags
#define hv_notallowed S_hv_notallowed
-#define hv_auxinit S_hv_auxinit
#define hv_delete_common S_hv_delete_common
#define hv_fetch_common S_hv_fetch_common
#endif
@@ -1209,9 +1217,6 @@
#define dofindlabel S_dofindlabel
#define doparseform S_doparseform
#define num_overflow S_num_overflow
-#define num_overflow S_num_overflow
-#endif
-#ifdef PERL_CORE
#define dopoptoeval S_dopoptoeval
#define dopoptogiven S_dopoptogiven
#define dopoptolabel S_dopoptolabel
@@ -1306,9 +1311,6 @@
#if defined(PERL_CORE) || defined(PERL_EXT)
#define make_trie S_make_trie
#endif
-#if defined(PERL_CORE) || defined(PERL_EXT)
-#define make_trie S_make_trie
-#endif
#endif
#if defined(PERL_IN_REGEXEC_C) || defined(PERL_DECL_PROT)
#if defined(PERL_CORE) || defined(PERL_EXT)
@@ -1349,17 +1351,10 @@
#if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT)
#ifdef PERL_CORE
#define uiv_2buf S_uiv_2buf
-#define sv_unglob S_sv_unglob
#define not_a_number S_not_a_number
#define visit S_visit
-#define sv_del_backref S_sv_del_backref
#define varname S_varname
#endif
-# ifdef DEBUGGING
-#ifdef PERL_CORE
-#define del_sv S_del_sv
-#endif
-# endif
# if !defined(NV_PRESERVES_UV)
#ifdef PERL_CORE
#define sv_2iuv_non_preserve S_sv_2iuv_non_preserve
@@ -1552,11 +1547,16 @@
#endif
#endif
#define save_set_svflags Perl_save_set_svflags
+#define save_set_padstale Perl_save_set_padstale
#define hv_scalar Perl_hv_scalar
+#ifdef NOT_YET
#define hv_name_set Perl_hv_name_set
+#endif
#if defined(PERL_IN_DUMP_C) || defined(PERL_IN_HV_C) || defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT)
#endif
#define hv_clear_placeholders Perl_hv_clear_placeholders
+#if 0
+#endif
#ifdef PERL_CORE
#define magic_scalarpack Perl_magic_scalarpack
#endif
@@ -1712,6 +1712,8 @@
#endif
#ifdef PERL_IMPLICIT_CONTEXT
#endif
+#if defined(PERL_CORE) || defined(PONIE_CORE)
+#endif
#define ck_anoncode Perl_ck_anoncode
#define ck_bitop Perl_ck_bitop
#define ck_concat Perl_ck_concat
@@ -2843,12 +2845,6 @@
#if defined(PERL_CORE) || defined(PONIE_CORE)
#ifdef PERL_CORE
#endif
-#ifdef PERL_CORE
-#endif
-#ifdef PERL_CORE
-#endif
-#ifdef PERL_CORE
-#endif
#endif
#define sv_2nv(a) Perl_sv_2nv(aTHX_ a)
#define sv_2pv_flags(a,b,c) Perl_sv_2pv_flags(aTHX_ a,b,c)
@@ -2890,8 +2886,6 @@
#define sv_eq(a,b) Perl_sv_eq(aTHX_ a,b)
#define sv_free(a) Perl_sv_free(aTHX_ a)
#ifdef PERL_CORE
-#endif
-#ifdef PERL_CORE
#define sv_free_arenas() Perl_sv_free_arenas(aTHX)
#endif
#define sv_gets(a,b,c) Perl_sv_gets(aTHX_ a,b,c)
@@ -2920,10 +2914,6 @@
#if defined(PERL_CORE) || defined(PONIE_CORE)
#ifdef PERL_CORE
#endif
-#ifdef PERL_CORE
-#endif
-#ifdef PERL_CORE
-#endif
#endif
#define sv_reset(a,b) Perl_sv_reset(aTHX_ a,b)
#define sv_vsetpvf(a,b,c) Perl_sv_vsetpvf(aTHX_ a,b,c)
@@ -3082,6 +3072,15 @@
#define mg_dup(a,b) Perl_mg_dup(aTHX_ a,b)
#define sv_dup(a,b) Perl_sv_dup(aTHX_ a,b)
#define rvpv_dup(a,b,c) Perl_rvpv_dup(aTHX_ a,b,c)
+#define ptr_table_new() Perl_ptr_table_new(aTHX)
+#define ptr_table_fetch(a,b) Perl_ptr_table_fetch(aTHX_ a,b)
+#define ptr_table_store(a,b,c) Perl_ptr_table_store(aTHX_ a,b,c)
+#define ptr_table_split(a) Perl_ptr_table_split(aTHX_ a)
+#define ptr_table_clear(a) Perl_ptr_table_clear(aTHX_ a)
+#define ptr_table_free(a) Perl_ptr_table_free(aTHX_ a)
+# if defined(HAVE_INTERP_INTERN)
+#define sys_intern_dup(a,b) Perl_sys_intern_dup(aTHX_ a,b)
+# endif
#endif
#define ptr_table_new() Perl_ptr_table_new(aTHX)
#define ptr_table_delete(a,b) Perl_ptr_table_delete(aTHX_ a,b)
@@ -3093,10 +3092,6 @@
#define ptr_table_split(a) Perl_ptr_table_split(aTHX_ a)
#define ptr_table_clear(a) Perl_ptr_table_clear(aTHX_ a)
#define ptr_table_free(a) Perl_ptr_table_free(aTHX_ a)
-# if defined(HAVE_INTERP_INTERN)
-#define sys_intern_dup(a,b) Perl_sys_intern_dup(aTHX_ a,b)
-# endif
-#endif
#if defined(HAVE_INTERP_INTERN)
#define sys_intern_clear() Perl_sys_intern_clear(aTHX)
#define sys_intern_init() Perl_sys_intern_init(aTHX)
@@ -3110,6 +3105,10 @@
#endif
#define sv_nosharing(a) Perl_sv_nosharing(aTHX_ a)
#define nothreadhook() Perl_nothreadhook(aTHX)
+#if defined(PERL_IN_GV_C) || defined(PERL_IN_SV_C) || defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT)
+#ifdef PERL_CORE
+#endif
+#endif
#if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT)
#ifdef PERL_CORE
#define do_trans_simple(a) S_do_trans_simple(aTHX_ a)
@@ -3130,13 +3129,14 @@
#ifdef PERL_CORE
#define hsplit(a) S_hsplit(aTHX_ a)
#define hfreeentries(a) S_hfreeentries(aTHX_ a)
+#define more_he() S_more_he(aTHX)
#define new_he() S_new_he(aTHX)
+#define del_he(a) S_del_he(aTHX_ a)
#define save_hek_flags(a,b,c,d) S_save_hek_flags(aTHX_ a,b,c,d)
#define hv_magic_check(a,b,c) S_hv_magic_check(aTHX_ a,b,c)
#define unshare_hek_or_pvn(a,b,c,d) S_unshare_hek_or_pvn(aTHX_ a,b,c,d)
#define share_hek_flags(a,b,c,d) S_share_hek_flags(aTHX_ a,b,c,d)
#define hv_notallowed(a,b,c,d) S_hv_notallowed(aTHX_ a,b,c,d)
-#define hv_auxinit(a) S_hv_auxinit(aTHX_ a)
#define hv_delete_common(a,b,c,d,e,f,g) S_hv_delete_common(aTHX_ a,b,c,d,e,f,g)
#define hv_fetch_common(a,b,c,d,e,f,g,h) S_hv_fetch_common(aTHX_ a,b,c,d,e,f,g,h)
#endif
@@ -3281,9 +3281,6 @@
#define dofindlabel(a,b,c,d) S_dofindlabel(aTHX_ a,b,c,d)
#define doparseform(a) S_doparseform(aTHX_ a)
#define num_overflow S_num_overflow
-#define num_overflow S_num_overflow
-#endif
-#ifdef PERL_CORE
#define dopoptoeval(a) S_dopoptoeval(aTHX_ a)
#define dopoptogiven(a) S_dopoptogiven(aTHX_ a)
#define dopoptolabel(a) S_dopoptolabel(aTHX_ a)
@@ -3377,9 +3374,6 @@
#if defined(PERL_CORE) || defined(PERL_EXT)
#define make_trie(a,b,c,d,e,f) S_make_trie(aTHX_ a,b,c,d,e,f)
#endif
-#if defined(PERL_CORE) || defined(PERL_EXT)
-#define make_trie(a,b,c,d,e,f) S_make_trie(aTHX_ a,b,c,d,e,f)
-#endif
#endif
#if defined(PERL_IN_REGEXEC_C) || defined(PERL_DECL_PROT)
#if defined(PERL_CORE) || defined(PERL_EXT)
@@ -3424,17 +3418,10 @@
#if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT)
#ifdef PERL_CORE
#define uiv_2buf S_uiv_2buf
-#define sv_unglob(a) S_sv_unglob(aTHX_ a)
#define not_a_number(a) S_not_a_number(aTHX_ a)
#define visit(a,b,c) S_visit(aTHX_ a,b,c)
-#define sv_del_backref(a,b) S_sv_del_backref(aTHX_ a,b)
#define varname(a,b,c,d,e,f) S_varname(aTHX_ a,b,c,d,e,f)
#endif
-# ifdef DEBUGGING
-#ifdef PERL_CORE
-#define del_sv(a) S_del_sv(aTHX_ a)
-#endif
-# endif
# if !defined(NV_PRESERVES_UV)
#ifdef PERL_CORE
#define sv_2iuv_non_preserve(a,b) S_sv_2iuv_non_preserve(aTHX_ a,b)
@@ -3627,15 +3614,20 @@
#endif
#endif
#define save_set_svflags(a,b,c) Perl_save_set_svflags(aTHX_ a,b,c)
+#define save_set_padstale(a) Perl_save_set_padstale(aTHX_ a)
#define hv_scalar(a) Perl_hv_scalar(aTHX_ a)
+#ifdef NOT_YET
#define hv_name_set(a,b,c,d) Perl_hv_name_set(aTHX_ a,b,c,d)
#ifdef PERL_CORE
#endif
+#endif
#if defined(PERL_IN_DUMP_C) || defined(PERL_IN_HV_C) || defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT)
#ifdef PERL_CORE
#endif
#endif
#define hv_clear_placeholders(a) Perl_hv_clear_placeholders(aTHX_ a)
+#if 0
+#endif
#ifdef PERL_CORE
#define magic_scalarpack(a,b) Perl_magic_scalarpack(aTHX_ a,b)
#endif
@@ -3791,6 +3783,10 @@
#endif
#ifdef PERL_IMPLICIT_CONTEXT
#endif
+#if defined(PERL_CORE) || defined(PONIE_CORE)
+#ifdef PERL_CORE
+#endif
+#endif
#define ck_anoncode(a) Perl_ck_anoncode(aTHX_ a)
#define ck_bitop(a) Perl_ck_bitop(aTHX_ a)
#define ck_concat(a) Perl_ck_concat(aTHX_ a)
Modified: branches/5.9.3merge/perl/embedvar.h
==============================================================================
--- branches/5.9.3merge/perl/embedvar.h (original)
+++ branches/5.9.3merge/perl/embedvar.h Thu Mar 16 14:07:54 2006
@@ -193,8 +193,6 @@
#define PL_beginav (vTHX->Ibeginav)
#define PL_beginav_save (vTHX->Ibeginav_save)
#define PL_bitcount (vTHX->Ibitcount)
-#define PL_body_arenaroots (vTHX->Ibody_arenaroots)
-#define PL_body_roots (vTHX->Ibody_roots)
#define PL_bufend (vTHX->Ibufend)
#define PL_bufptr (vTHX->Ibufptr)
#define PL_checkav (vTHX->Icheckav)
@@ -259,6 +257,8 @@
#define PL_globalstash (vTHX->Iglobalstash)
#define PL_hash_seed (vTHX->Ihash_seed)
#define PL_hash_seed_set (vTHX->Ihash_seed_set)
+#define PL_he_arenaroot (vTHX->Ihe_arenaroot)
+#define PL_he_root (vTHX->Ihe_root)
#define PL_hintgv (vTHX->Ihintgv)
#define PL_hints (vTHX->Ihints)
#define PL_in_clean_all (vTHX->Iin_clean_all)
@@ -399,7 +399,7 @@
#define PL_subline (vTHX->Isubline)
#define PL_subname (vTHX->Isubname)
#define PL_suidscript (vTHX->Isuidscript)
-#define PL_sv_arenaroot (vTHX->Isv_arenaroot)
+#define PL_sv_arenatable (vTHX->Isv_arenatable)
#define PL_sv_count (vTHX->Isv_count)
#define PL_sv_no_p (vTHX->Isv_no_p)
#define PL_sv_objcount (vTHX->Isv_objcount)
@@ -440,6 +440,28 @@
#define PL_uudmap (vTHX->Iuudmap)
#define PL_warnhook (vTHX->Iwarnhook)
#define PL_widesyscalls (vTHX->Iwidesyscalls)
+#define PL_xiv_arenaroot (vTHX->Ixiv_arenaroot)
+#define PL_xiv_root (vTHX->Ixiv_root)
+#define PL_xnv_arenaroot (vTHX->Ixnv_arenaroot)
+#define PL_xnv_root (vTHX->Ixnv_root)
+#define PL_xpv_arenaroot (vTHX->Ixpv_arenaroot)
+#define PL_xpv_root (vTHX->Ixpv_root)
+#define PL_xpvav_arenaroot (vTHX->Ixpvav_arenaroot)
+#define PL_xpvav_root (vTHX->Ixpvav_root)
+#define PL_xpvbm_arenaroot (vTHX->Ixpvbm_arenaroot)
+#define PL_xpvbm_root (vTHX->Ixpvbm_root)
+#define PL_xpvcv_arenaroot (vTHX->Ixpvcv_arenaroot)
+#define PL_xpvcv_root (vTHX->Ixpvcv_root)
+#define PL_xpvhv_arenaroot (vTHX->Ixpvhv_arenaroot)
+#define PL_xpvhv_root (vTHX->Ixpvhv_root)
+#define PL_xpviv_arenaroot (vTHX->Ixpviv_arenaroot)
+#define PL_xpviv_root (vTHX->Ixpviv_root)
+#define PL_xpvlv_arenaroot (vTHX->Ixpvlv_arenaroot)
+#define PL_xpvlv_root (vTHX->Ixpvlv_root)
+#define PL_xpvmg_arenaroot (vTHX->Ixpvmg_arenaroot)
+#define PL_xpvmg_root (vTHX->Ixpvmg_root)
+#define PL_xpvnv_arenaroot (vTHX->Ixpvnv_arenaroot)
+#define PL_xpvnv_root (vTHX->Ixpvnv_root)
#define PL_yycharp (vTHX->Iyycharp)
#define PL_yylvalp (vTHX->Iyylvalp)
@@ -480,8 +502,6 @@
#define PL_Ibeginav PL_beginav
#define PL_Ibeginav_save PL_beginav_save
#define PL_Ibitcount PL_bitcount
-#define PL_Ibody_arenaroots PL_body_arenaroots
-#define PL_Ibody_roots PL_body_roots
#define PL_Ibufend PL_bufend
#define PL_Ibufptr PL_bufptr
#define PL_Icheckav PL_checkav
@@ -546,6 +566,8 @@
#define PL_Iglobalstash PL_globalstash
#define PL_Ihash_seed PL_hash_seed
#define PL_Ihash_seed_set PL_hash_seed_set
+#define PL_Ihe_arenaroot PL_he_arenaroot
+#define PL_Ihe_root PL_he_root
#define PL_Ihintgv PL_hintgv
#define PL_Ihints PL_hints
#define PL_Iin_clean_all PL_in_clean_all
@@ -686,7 +708,7 @@
#define PL_Isubline PL_subline
#define PL_Isubname PL_subname
#define PL_Isuidscript PL_suidscript
-#define PL_Isv_arenaroot PL_sv_arenaroot
+#define PL_Isv_arenatable PL_sv_arenatable
#define PL_Isv_count PL_sv_count
#define PL_Isv_no_p PL_sv_no_p
#define PL_Isv_objcount PL_sv_objcount
@@ -727,6 +749,28 @@
#define PL_Iuudmap PL_uudmap
#define PL_Iwarnhook PL_warnhook
#define PL_Iwidesyscalls PL_widesyscalls
+#define PL_Ixiv_arenaroot PL_xiv_arenaroot
+#define PL_Ixiv_root PL_xiv_root
+#define PL_Ixnv_arenaroot PL_xnv_arenaroot
+#define PL_Ixnv_root PL_xnv_root
+#define PL_Ixpv_arenaroot PL_xpv_arenaroot
+#define PL_Ixpv_root PL_xpv_root
+#define PL_Ixpvav_arenaroot PL_xpvav_arenaroot
+#define PL_Ixpvav_root PL_xpvav_root
+#define PL_Ixpvbm_arenaroot PL_xpvbm_arenaroot
+#define PL_Ixpvbm_root PL_xpvbm_root
+#define PL_Ixpvcv_arenaroot PL_xpvcv_arenaroot
+#define PL_Ixpvcv_root PL_xpvcv_root
+#define PL_Ixpvhv_arenaroot PL_xpvhv_arenaroot
+#define PL_Ixpvhv_root PL_xpvhv_root
+#define PL_Ixpviv_arenaroot PL_xpviv_arenaroot
+#define PL_Ixpviv_root PL_xpviv_root
+#define PL_Ixpvlv_arenaroot PL_xpvlv_arenaroot
+#define PL_Ixpvlv_root PL_xpvlv_root
+#define PL_Ixpvmg_arenaroot PL_xpvmg_arenaroot
+#define PL_Ixpvmg_root PL_xpvmg_root
+#define PL_Ixpvnv_arenaroot PL_xpvnv_arenaroot
+#define PL_Ixpvnv_root PL_xpvnv_root
#define PL_Iyycharp PL_yycharp
#define PL_Iyylvalp PL_yylvalp
@@ -892,6 +936,14 @@
#define PL_Gperlio_debug_fd (my_vars->Gperlio_debug_fd)
#define PL_perlio_fd_refcnt (my_vars->Gperlio_fd_refcnt)
#define PL_Gperlio_fd_refcnt (my_vars->Gperlio_fd_refcnt)
+#define PL_pmc_to_type (my_vars->Gpmc_to_type)
+#define PL_Gpmc_to_type (my_vars->Gpmc_to_type)
+#define PL_pmc_to_type_max (my_vars->Gpmc_to_type_max)
+#define PL_Gpmc_to_type_max (my_vars->Gpmc_to_type_max)
+#define PL_pmcname (my_vars->Gpmcname)
+#define PL_Gpmcname (my_vars->Gpmcname)
+#define PL_pmcname_mutex (my_vars->Gpmcname_mutex)
+#define PL_Gpmcname_mutex (my_vars->Gpmcname_mutex)
#define PL_ppaddr (my_vars->Gppaddr)
#define PL_Gppaddr (my_vars->Gppaddr)
#define PL_sh_path (my_vars->Gsh_path)
@@ -908,8 +960,6 @@
#define PL_Gsig_trapped (my_vars->Gsig_trapped)
#define PL_sigfpe_saved (my_vars->Gsigfpe_saved)
#define PL_Gsigfpe_saved (my_vars->Gsigfpe_saved)
-#define PL_sv_placeholder (my_vars->Gsv_placeholder)
-#define PL_Gsv_placeholder (my_vars->Gsv_placeholder)
#define PL_thr_key (my_vars->Gthr_key)
#define PL_Gthr_key (my_vars->Gthr_key)
#define PL_timesbase (my_vars->Gtimesbase)
@@ -918,7 +968,6 @@
#define PL_Guse_safe_putenv (my_vars->Guse_safe_putenv)
#define PL_watch_pvx (my_vars->Gwatch_pvx)
#define PL_Gwatch_pvx (my_vars->Gwatch_pvx)
-#define PL_use_safe_putenv (PL_Vars.Guse_safe_putenv)
#else /* !PERL_GLOBAL_STRUCT */
@@ -942,6 +991,10 @@
#define PL_Gpatleave PL_patleave
#define PL_Gperlio_debug_fd PL_perlio_debug_fd
#define PL_Gperlio_fd_refcnt PL_perlio_fd_refcnt
+#define PL_Gpmc_to_type PL_pmc_to_type
+#define PL_Gpmc_to_type_max PL_pmc_to_type_max
+#define PL_Gpmcname PL_pmcname
+#define PL_Gpmcname_mutex PL_pmcname_mutex
#define PL_Gppaddr PL_ppaddr
#define PL_Gsh_path PL_sh_path
#define PL_Gsig_defaulting PL_sig_defaulting
Modified: branches/5.9.3merge/perl/global.sym
==============================================================================
--- branches/5.9.3merge/perl/global.sym (original)
+++ branches/5.9.3merge/perl/global.sym Thu Mar 16 14:07:54 2006
@@ -641,16 +641,16 @@
Perl_sv_dup
Perl_rvpv_dup
Perl_ptr_table_new
-Perl_ptr_table_delete
Perl_ptr_table_fetch
Perl_ptr_table_store
-Perl_ptr_table_inc
-Perl_ptr_table_dec
-Perl_ptr_table_val
Perl_ptr_table_split
Perl_ptr_table_clear
Perl_ptr_table_free
Perl_sys_intern_dup
+Perl_ptr_table_delete
+Perl_ptr_table_inc
+Perl_ptr_table_dec
+Perl_ptr_table_val
Perl_sys_intern_clear
Perl_sys_intern_init
Perl_custom_op_name
@@ -695,6 +695,7 @@
Perl_PerlIO_stderr
Perl_pad_push
Perl_save_set_svflags
+Perl_save_set_padstale
Perl_hv_assert
Perl_hv_scalar
Perl_hv_riter_p
Modified: branches/5.9.3merge/perl/gv.h
==============================================================================
--- branches/5.9.3merge/perl/gv.h (original)
+++ branches/5.9.3merge/perl/gv.h Thu Mar 16 14:07:54 2006
@@ -11,7 +11,7 @@
struct gp {
SV * gp_sv; /* scalar value */
U32 gp_refcnt; /* how many globs point to this? */
- struct io * gp_io; /* filehandle value */
+ IO * gp_io; /* filehandle value */
CV * gp_form; /* format value */
AV * gp_av; /* array value */
HV * gp_hv; /* hash value */
Modified: branches/5.9.3merge/perl/handy.h
==============================================================================
--- branches/5.9.3merge/perl/handy.h (original)
+++ branches/5.9.3merge/perl/handy.h Thu Mar 16 14:07:54 2006
@@ -622,6 +622,8 @@
=cut */
+#ifndef lint
+
/* Maintained for backwards-compatibility only. Use newSV() instead. */
#ifndef PERL_CORE
#define NEWSV(x,len) newSV(len)
Modified: branches/5.9.3merge/perl/hv.c
==============================================================================
--- branches/5.9.3merge/perl/hv.c (original)
+++ branches/5.9.3merge/perl/hv.c Thu Mar 16 14:07:54 2006
@@ -36,18 +36,21 @@
static const char S_strtab_error[]
= "Cannot modify shared string table in hv_%s";
+
+
STATIC void
S_more_he(pTHX)
{
- dVAR;
- HE* he;
- HE* heend;
- Newx(he, PERL_ARENA_SIZE/sizeof(HE), HE);
- HeNEXT(he) = (HE*) PL_body_arenaroots[HE_SVSLOT];
- PL_body_arenaroots[HE_SVSLOT] = he;
+ register HE* he;
+ register HE* heend;
+ XPV *ptr;
+ Newx(ptr, PERL_ARENA_SIZE/sizeof(XPV), XPV);
+ ptr->xpv_pv = (char*)PL_he_arenaroot;
+ PL_he_arenaroot = ptr;
+ he = (HE*)ptr;
heend = &he[PERL_ARENA_SIZE / sizeof(HE) - 1];
- PL_body_roots[HE_SVSLOT] = ++he;
+ PL_he_root = ++he;
while (he < heend) {
HeNEXT(he) = (HE*)(he + 1);
he++;
@@ -55,39 +58,37 @@
HeNEXT(he) = 0;
}
-#ifdef PURIFY
-
-#define new_HE() (HE*)safemalloc(sizeof(HE))
-#define del_HE(p) safefree((char*)p)
-
-#else
-
STATIC HE*
S_new_he(pTHX)
{
- dVAR;
HE* he;
- void ** const root = &PL_body_roots[HE_SVSLOT];
-
LOCK_SV_MUTEX;
- if (!*root)
- S_more_he(aTHX);
- he = *root;
- *root = HeNEXT(he);
+ if (!PL_he_root)
+ more_he();
+ he = PL_he_root;
+ PL_he_root = HeNEXT(he);
UNLOCK_SV_MUTEX;
return he;
}
-#define new_HE() new_he()
-#define del_HE(p) \
- STMT_START { \
- LOCK_SV_MUTEX; \
- HeNEXT(p) = (HE*)(PL_body_roots[HE_SVSLOT]); \
- PL_body_roots[HE_SVSLOT] = p; \
- UNLOCK_SV_MUTEX; \
- } STMT_END
+STATIC void
+S_del_he(pTHX_ HE *p)
+{
+ LOCK_SV_MUTEX;
+ HeNEXT(p) = (HE*)PL_he_root;
+ PL_he_root = p;
+ UNLOCK_SV_MUTEX;
+}
+
+#ifdef PURIFY
+#define new_HE() (HE*)safemalloc(sizeof(HE))
+#define del_HE(p) safefree((char*)p)
+#else
+
+#define new_HE() new_he()
+#define del_HE(p) del_he(p)
#endif
@@ -748,9 +749,6 @@
}
if (flags & HVhek_FREEKEY)
Safefree(key);
- }
- if (flags & HVhek_FREEKEY)
- Safefree(key);
return entry;
}
#ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */
@@ -834,10 +832,10 @@
{
const HE *counter = HeNEXT(entry);
- xhv->xhv_keys++; /* HvKEYS(hv)++ */
+ HvTOTALKEYS(hv)++;
if (!counter) { /* initial entry? */
- xhv->xhv_fill++; /* HvFILL(hv)++ */
- } else if (xhv->xhv_keys > (IV)xhv->xhv_max) {
+ HvFILL(hv)++;
+ } else if (HvKEYS(hv) > (IV)HvMAX(hv)) {
hsplit(hv);
} else if(!HvREHASH(hv)) {
U32 n_links = 1;
@@ -1014,7 +1012,6 @@
}
#endif
}
- }
}
}
xhv = (XPVHV*)SvANY(hv);
@@ -1107,9 +1104,9 @@
} else {
*oentry = HeNEXT(entry);
if(!*first_entry) {
- xhv->xhv_fill--; /* HvFILL(hv)-- */
+ HvFILL(hv)--;
}
- if (SvOOK(hv) && entry == HvAUX(hv)->xhv_eiter /* HvEITER(hv) */)
+ if (entry == HvEITER(hv))
HvLAZYDEL_on(hv);
else
hv_free_ent(hv, entry);
@@ -1157,30 +1154,21 @@
PL_nomemok = TRUE;
#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
- Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize)
- + (SvOOK(hv) ? sizeof(struct xpvhv_aux) : 0), char);
+ Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
if (!a) {
PL_nomemok = FALSE;
return;
}
- if (SvOOK(hv)) {
- Copy(&a[oldsize * sizeof(HE*)], &a[newsize * sizeof(HE*)], 1, struct xpvhv_aux);
- }
#else
- Newx(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize)
- + (SvOOK(hv) ? sizeof(struct xpvhv_aux) : 0), char);
+ Newx(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
if (!a) {
PL_nomemok = FALSE;
return;
}
Copy(HvARRAY(hv), a, oldsize * sizeof(HE*), char);
- if (SvOOK(hv)) {
- Copy(HvAUX(hv), &a[newsize * sizeof(HE*)], 1, struct xpvhv_aux);
- }
if (oldsize >= 64) {
offer_nice_chunk(HvARRAY(hv),
- PERL_HV_ARRAY_ALLOC_BYTES(oldsize)
- + (SvOOK(hv) ? sizeof(struct xpvhv_aux) : 0));
+ PERL_HV_ARRAY_ALLOC_BYTES(oldsize));
}
else
Safefree(HvARRAY(hv));
@@ -1225,13 +1213,6 @@
longest_chain = left_length;
if (right_length > longest_chain)
longest_chain = right_length;
- /* I think we don't actually need to keep track of the longest length,
- merely flag if anything is too long. But for the moment while
- developing this code I'll track it. */
- if (left_length > longest_chain)
- longest_chain = left_length;
- if (right_length > longest_chain)
- longest_chain = right_length;
}
@@ -1252,11 +1233,7 @@
longest_chain, HvTOTALKEYS(hv), HvFILL(hv), 1+HvMAX(hv));*/
++newsize;
- Newxz(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize)
- + (SvOOK(hv) ? sizeof(struct xpvhv_aux) : 0), char);
- if (SvOOK(hv)) {
- Copy(HvAUX(hv), &a[newsize * sizeof(HE*)], 1, struct xpvhv_aux);
- }
+ Newxz(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
was_shared = HvSHAREKEYS(hv);
@@ -1335,30 +1312,21 @@
if (a) {
PL_nomemok = TRUE;
#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
- Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize)
- + (SvOOK(hv) ? sizeof(struct xpvhv_aux) : 0), char);
+ Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
if (!a) {
PL_nomemok = FALSE;
return;
}
- if (SvOOK(hv)) {
- Copy(&a[oldsize * sizeof(HE*)], &a[newsize * sizeof(HE*)], 1, struct xpvhv_aux);
- }
#else
- Newx(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize)
- + (SvOOK(hv) ? sizeof(struct xpvhv_aux) : 0), char);
+ Newx(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
if (!a) {
PL_nomemok = FALSE;
return;
}
Copy(HvARRAY(hv), a, oldsize * sizeof(HE*), char);
- if (SvOOK(hv)) {
- Copy(HvAUX(hv), &a[newsize * sizeof(HE*)], 1, struct xpvhv_aux);
- }
if (oldsize >= 64) {
offer_nice_chunk(HvARRAY(hv),
- PERL_HV_ARRAY_ALLOC_BYTES(oldsize)
- + (SvOOK(hv) ? sizeof(struct xpvhv_aux) : 0));
+ PERL_HV_ARRAY_ALLOC_BYTES(oldsize));
}
else
Safefree(HvARRAY(hv));
@@ -1417,8 +1385,10 @@
HvSHAREKEYS_on(hv); /* key-sharing on by default */
#endif
- xhv->xhv_max = 7; /* HvMAX(hv) = 7 (start with 8 buckets) */
- xhv->xhv_fill = 0; /* HvFILL(hv) = 0 */
+ HvMAX(hv) = 7; /* (start with 8 buckets) */
+ HvFILL(hv) = 0;
+ HvPMROOT(hv) = 0;
+ (void)hv_iterinit(hv); /* so each() will start off right */
return hv;
}
@@ -1658,140 +1628,48 @@
assert (0);
}
+
STATIC void
S_hfreeentries(pTHX_ HV *hv)
{
- /* This is the array that we're going to restore */
- HE **orig_array;
- HEK *name;
- int attempts = 100;
+ register HE **array;
+ register HE *entry;
+ register HE *oentry = Null(HE*);
+ I32 riter;
+ I32 max;
+ if (!hv)
+ return;
if (!HvARRAY(hv))
return;
- if (SvOOK(hv)) {
- /* If the hash is actually a symbol table with a name, look after the
- name. */
- struct xpvhv_aux *iter = HvAUX(hv);
-
- name = iter->xhv_name;
- iter->xhv_name = NULL;
- } else {
- name = NULL;
- }
-
- orig_array = HvARRAY(hv);
- /* orig_array remains unchanged throughout the loop. If after freeing all
- the entries it turns out that one of the little blighters has triggered
- an action that has caused HvARRAY to be re-allocated, then we set
- array to the new HvARRAY, and try again. */
-
- while (1) {
- /* This is the one we're going to try to empty. First time round
- it's the original array. (Hopefully there will only be 1 time
- round) */
- HE ** const array = HvARRAY(hv);
- I32 i = HvMAX(hv);
-
- /* Because we have taken xhv_name out, the only allocated pointer
- in the aux structure that might exist is the backreference array.
- */
-
- if (SvOOK(hv)) {
- HE *entry;
- struct xpvhv_aux *iter = HvAUX(hv);
- /* If there are weak references to this HV, we need to avoid
- freeing them up here. In particular we need to keep the AV
- visible as what we're deleting might well have weak references
- back to this HV, so the for loop below may well trigger
- the removal of backreferences from this array. */
-
- if (iter->xhv_backreferences) {
- /* So donate them to regular backref magic to keep them safe.
- The sv_magic will increase the reference count of the AV,
- so we need to drop it first. */
- SvREFCNT_dec(iter->xhv_backreferences);
- if (AvFILLp(iter->xhv_backreferences) == -1) {
- /* Turns out that the array is empty. Just free it. */
- SvREFCNT_dec(iter->xhv_backreferences);
-
- } else {
- sv_magic((SV*)hv, (SV*)iter->xhv_backreferences,
- PERL_MAGIC_backref, NULL, 0);
- }
- iter->xhv_backreferences = NULL;
- }
-
- entry = iter->xhv_eiter; /* HvEITER(hv) */
- if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */
- HvLAZYDEL_off(hv);
- hv_free_ent(hv, entry);
- }
- iter->xhv_riter = -1; /* HvRITER(hv) = -1 */
- iter->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
-
- /* There are now no allocated pointers in the aux structure. */
-
- SvFLAGS(hv) &= ~SVf_OOK; /* Goodbye, aux structure. */
- /* What aux structure? */
- }
-
- /* make everyone else think the array is empty, so that the destructors
- * called for freed entries can't recusively mess with us */
- HvARRAY(hv) = NULL;
- HvFILL(hv) = 0;
- ((XPVHV*) SvANY(hv))->xhv_keys = 0;
-
-
- do {
- /* Loop down the linked list heads */
- HE *entry = array[i];
+ riter = 0;
+ max = HvMAX(hv);
+ array = HvARRAY(hv);
+ /* make everyone else think the array is empty, so that the destructors
+ * called for freed entries can't recusively mess with us */
+ HvARRAY(hv) = Null(HE**);
+ HvFILL(hv) = 0;
+ HvTOTALKEYS(hv) = 0;
- while (entry) {
- register HE * const oentry = entry;
- entry = HeNEXT(entry);
- hv_free_ent(hv, oentry);
- }
- } while (--i >= 0);
-
- /* As there are no allocated pointers in the aux structure, it's now
- safe to free the array we just cleaned up, if it's not the one we're
- going to put back. */
- if (array != orig_array) {
- Safefree(array);
- }
-
- if (!HvARRAY(hv)) {
- /* Good. No-one added anything this time round. */
- break;
- }
-
- if (SvOOK(hv)) {
- /* Someone attempted to iterate or set the hash name while we had
- the array set to 0. We'll catch backferences on the next time
- round the while loop. */
- assert(HvARRAY(hv));
-
- if (HvAUX(hv)->xhv_name) {
- unshare_hek_or_pvn(HvAUX(hv)->xhv_name, 0, 0, 0);
- }
- }
-
- if (--attempts == 0) {
- Perl_die(aTHX_ "panic: hfreeentries failed to free hash - something is repeatedly re-creating entries");
+ entry = array[0];
+ for (;;) {
+ if (entry) {
+ oentry = entry;
+ entry = HeNEXT(entry);
+ hv_free_ent(hv, oentry);
+ }
+ if (!entry) {
+ if (++riter > max)
+ break;
+ entry = array[riter];
}
}
-
- HvARRAY(hv) = orig_array;
-
- /* If the hash was actually a symbol table, put the name back. */
- if (name) {
- /* We have restored the original array. If name is non-NULL, then
- the original array had an aux structure at the end. So this is
- valid: */
- SvFLAGS(hv) |= SVf_OOK;
- HvAUX(hv)->xhv_name = name;
- }
+ /* FIXME - convert blead's retry 100 times then panic routine to one that
+ uses the old style layout (no HvAUX) and merge that. eg once 5.8.x gets
+ it. */
+ HvARRAY(hv) = array;
+ (void)hv_iterinit(hv);
}
/*
@@ -1819,7 +1697,6 @@
hv_delete(PL_stashcache, name, HvNAMELEN_get(hv), G_DISCARD);
hv_name_set(hv, Nullch, 0, 0);
}
- SvFLAGS(hv) &= ~SVf_OOK;
Safefree(HvARRAY(hv));
xhv->xhv_max = 7; /* HvMAX(hv) = 7 (it's a normal hash) */
HvARRAY(hv) = 0;
@@ -1829,31 +1706,6 @@
mg_clear((SV*)hv);
}
-static struct xpvhv_aux*
-S_hv_auxinit(pTHX_ HV *hv) {
- struct xpvhv_aux *iter;
- char *array;
-
- if (!HvARRAY(hv)) {
- Newxz(array, PERL_HV_ARRAY_ALLOC_BYTES(HvMAX(hv) + 1)
- + sizeof(struct xpvhv_aux), char);
- } else {
- array = (char *) HvARRAY(hv);
- Renew(array, PERL_HV_ARRAY_ALLOC_BYTES(HvMAX(hv) + 1)
- + sizeof(struct xpvhv_aux), char);
- }
- HvARRAY(hv) = (HE**) array;
- /* SvOOK_on(hv) attacks the IV flags. */
- SvFLAGS(hv) |= SVf_OOK;
- iter = HvAUX(hv);
-
- iter->xhv_riter = -1; /* HvRITER(hv) = -1 */
- iter->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
- iter->xhv_name = 0;
- iter->xhv_backreferences = 0;
- return iter;
-}
-
/*
=for apidoc hv_iterinit
@@ -1872,131 +1724,21 @@
I32
Perl_hv_iterinit(pTHX_ HV *hv)
{
+ HE *entry;
+
if (!hv)
Perl_croak(aTHX_ "Bad hash");
-
- if (SvOOK(hv)) {
- struct xpvhv_aux * const iter = HvAUX(hv);
- HE * const entry = iter->xhv_eiter; /* HvEITER(hv) */
- if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */
- HvLAZYDEL_off(hv);
- hv_free_ent(hv, entry);
- }
- iter->xhv_riter = -1; /* HvRITER(hv) = -1 */
- iter->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
- } else {
- hv_auxinit(hv);
+ entry = HvEITER(hv);
+ if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */
+ HvLAZYDEL_off(hv);
+ hv_free_ent(hv, entry);
}
-
+ HvRITER(hv) = -1;
+ HvEITER(hv) = Null(HE*);
/* used to be xhv->xhv_fill before 5.004_65 */
return HvTOTALKEYS(hv);
}
-I32 *
-Perl_hv_riter_p(pTHX_ HV *hv) {
- struct xpvhv_aux *iter;
-
- if (!hv)
- Perl_croak(aTHX_ "Bad hash");
-
- iter = SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv);
- return &(iter->xhv_riter);
-}
-
-HE **
-Perl_hv_eiter_p(pTHX_ HV *hv) {
- struct xpvhv_aux *iter;
-
- if (!hv)
- Perl_croak(aTHX_ "Bad hash");
-
- iter = SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv);
- return &(iter->xhv_eiter);
-}
-
-void
-Perl_hv_riter_set(pTHX_ HV *hv, I32 riter) {
- struct xpvhv_aux *iter;
-
- if (!hv)
- Perl_croak(aTHX_ "Bad hash");
-
- if (SvOOK(hv)) {
- iter = HvAUX(hv);
- } else {
- if (riter == -1)
- return;
-
- iter = hv_auxinit(hv);
- }
- iter->xhv_riter = riter;
-}
-
-void
-Perl_hv_eiter_set(pTHX_ HV *hv, HE *eiter) {
- struct xpvhv_aux *iter;
-
- if (!hv)
- Perl_croak(aTHX_ "Bad hash");
-
- if (SvOOK(hv)) {
- iter = HvAUX(hv);
- } else {
- /* 0 is the default so don't go malloc()ing a new structure just to
- hold 0. */
- if (!eiter)
- return;
-
- iter = hv_auxinit(hv);
- }
- iter->xhv_eiter = eiter;
-}
-
-void
-Perl_hv_name_set(pTHX_ HV *hv, const char *name, I32 len, int flags)
-{
- dVAR;
- struct xpvhv_aux *iter;
- U32 hash;
-
- PERL_UNUSED_ARG(flags);
-
- if (SvOOK(hv)) {
- iter = HvAUX(hv);
- if (iter->xhv_name) {
- unshare_hek_or_pvn(iter->xhv_name, 0, 0, 0);
- }
- } else {
- if (name == 0)
- return;
-
- iter = hv_auxinit(hv);
- }
- PERL_HASH(hash, name, len);
- iter->xhv_name = name ? share_hek(name, len, hash) : 0;
-}
-
-AV **
-Perl_hv_backreferences_p(pTHX_ HV *hv) {
- struct xpvhv_aux * const iter = SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv);
- return &(iter->xhv_backreferences);
-}
-
-void
-Perl_hv_kill_backrefs(pTHX_ HV *hv) {
- AV *av;
-
- if (!SvOOK(hv))
- return;
-
- av = HvAUX(hv)->xhv_backreferences;
-
- if (av) {
- HvAUX(hv)->xhv_backreferences = 0;
- Perl_sv_kill_backrefs(aTHX_ (SV*) hv, av);
- }
-}
-
/*
hv_iternext is implemented as a macro in hv.h
@@ -2030,25 +1772,13 @@
Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
{
dVAR;
- register XPVHV* xhv;
register HE *entry;
HE *oldentry;
MAGIC* mg;
- struct xpvhv_aux *iter;
if (!hv)
Perl_croak(aTHX_ "Bad hash");
- xhv = (XPVHV*)SvANY(hv);
-
- if (!SvOOK(hv)) {
- /* Too many things (well, pp_each at least) merrily assume that you can
- call iv_iternext without calling hv_iterinit, so we'll have to deal
- with it. */
- hv_iterinit(hv);
- }
- iter = HvAUX(hv);
-
- oldentry = entry = iter->xhv_eiter; /* HvEITER(hv) */
+ oldentry = entry = HvEITER(hv);
if ((mg = SvTIED_mg((SV*)hv, PERL_MAGIC_tied))) {
SV * const key = sv_newmortal();
@@ -2061,7 +1791,7 @@
HEK *hek;
/* one HE per MAGICAL hash */
- iter->xhv_eiter = entry = new_HE(); /* HvEITER(hv) = new_HE() */
+ HvEITER(hv) = entry = new_HE();
Zero(entry, 1, HE);
Newxz(k, HEK_BASESIZE + sizeof(SV*), char);
hek = (HEK*)k;
@@ -2078,20 +1808,12 @@
SvREFCNT_dec(HeVAL(entry));
Safefree(HeKEY_hek(entry));
del_HE(entry);
- iter->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
+ HvEITER(hv) = Null(HE*);
return Null(HE*);
}
#ifdef DYNAMIC_ENV_FETCH /* set up %ENV for iteration */
if (!entry && SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
prime_env_iter();
-#ifdef VMS
- /* The prime_env_iter() on VMS just loaded up new hash values
- * so the iteration count needs to be reset back to the beginning
- */
- hv_iterinit(hv);
- iter = HvAUX(hv);
- oldentry = entry = iter->xhv_eiter; /* HvEITER(hv) */
-#endif
}
#endif
@@ -2115,13 +1837,13 @@
while (!entry) {
/* OK. Come to the end of the current list. Grab the next one. */
- iter->xhv_riter++; /* HvRITER(hv)++ */
- if (iter->xhv_riter > (I32)xhv->xhv_max /* HvRITER(hv) > HvMAX(hv) */) {
+ HvRITER(hv)++;
+ if (HvRITER(hv) > HvMAX(hv)) {
/* There is no next one. End of the hash. */
- iter->xhv_riter = -1; /* HvRITER(hv) = -1 */
+ HvRITER(hv) = -1;
break;
}
- entry = (HvARRAY(hv))[iter->xhv_riter];
+ entry = (HvARRAY(hv))[HvRITER(hv)];
if (!(flags & HV_ITERNEXT_WANTPLACEHOLDERS)) {
/* If we have an entry, but it's a placeholder, don't count it.
@@ -2142,7 +1864,7 @@
/*if (HvREHASH(hv) && entry && !HeKREHASH(entry))
PerlIO_printf(PerlIO_stderr(), "Awooga %p %p\n", hv, entry);*/
- iter->xhv_eiter = entry; /* HvEITER(hv) = entry */
+ HvEITER(hv) = entry;
return entry;
}
@@ -2267,7 +1989,6 @@
S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash)
{
dVAR;
- register XPVHV* xhv;
HE *entry;
register HE **oentry;
HE **first;
@@ -2341,7 +2062,6 @@
}
if (found) {
- /* XXX sizeof(SV) is quite possibly 0 in ponie, which shafts this. */
HeVAL(entry) = (SV *)(((void **)HeVAL(entry)) - 1);
if (HeVAL(entry) == Nullsv) {
*oentry = HeNEXT(entry);
@@ -2466,13 +2186,12 @@
HvTOTALKEYS(PL_strtab)++;
if (!next) { /* initial entry? */
xhv->xhv_fill++; /* HvFILL(hv)++ */
- } else if (xhv->xhv_keys > (IV)xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */) {
+ } else if (HvKEYS(PL_strtab) > HvMAX(PL_strtab)) {
hsplit(PL_strtab);
}
}
/* use value slot as REFCNT */
- /* XXX sizeof(SV) is quite possibly 0 in ponie, which shafts this. */
HeVAL(entry) = (SV *)(((void **) HeVAL(entry)) + 1);
UNLOCK_STRTAB_MUTEX;
@@ -2482,47 +2201,6 @@
return HeKEY_hek(entry);
}
-I32 *
-Perl_hv_placeholders_p(pTHX_ HV *hv)
-{
- dVAR;
- MAGIC *mg = mg_find((SV*)hv, PERL_MAGIC_rhash);
-
- if (!mg) {
- mg = sv_magicext((SV*)hv, 0, PERL_MAGIC_rhash, 0, 0, 0);
-
- if (!mg) {
- Perl_die(aTHX_ "panic: hv_placeholders_p");
- }
- }
- return &(mg->mg_len);
-}
-
-
-I32
-Perl_hv_placeholders_get(pTHX_ HV *hv)
-{
- dVAR;
- MAGIC * const mg = mg_find((SV*)hv, PERL_MAGIC_rhash);
-
- return mg ? mg->mg_len : 0;
-}
-
-void
-Perl_hv_placeholders_set(pTHX_ HV *hv, I32 ph)
-{
- dVAR;
- MAGIC * const mg = mg_find((SV*)hv, PERL_MAGIC_rhash);
-
- if (mg) {
- mg->mg_len = ph;
- } else if (ph) {
- if (!sv_magicext((SV*)hv, 0, PERL_MAGIC_rhash, 0, 0, ph))
- Perl_die(aTHX_ "panic: hv_placeholders_set");
- }
- /* else we don't need to add magic to record 0 placeholders. */
-}
-
/*
=for apidoc hv_assert
Modified: branches/5.9.3merge/perl/hv.h
==============================================================================
--- branches/5.9.3merge/perl/hv.h (original)
+++ branches/5.9.3merge/perl/hv.h Thu Mar 16 14:07:54 2006
@@ -29,6 +29,11 @@
is UTF-8 */
};
+struct shared_he {
+ struct he shared_he_he;
+ struct hek shared_he_hek;
+};
+
/* hash structure: */
/* This structure must match the beginning of struct xpvmg in sv.h. */
struct xpvhv {
@@ -178,9 +183,16 @@
#define HvFILL(hv) ((XPVHV*) SvANY(hv))->xhv_fill
#define HvMAX(hv) ((XPVHV*) SvANY(hv))->xhv_max
#define HvRITER(hv) ((XPVHV*) SvANY(hv))->xhv_riter
+#define HvRITER_get(hv) (0 + ((XPVHV*) SvANY(hv))->xhv_riter)
+#define HvRITER_set(hv,r) (HvRITER(hv) = (r))
#define HvEITER(hv) ((XPVHV*) SvANY(hv))->xhv_eiter
+#define HvEITER_get(hv) (0 + ((XPVHV*) SvANY(hv))->xhv_eiter)
+#define HvEITER_set(hv,e) (HvEITER(hv) = (e))
#define HvPMROOT(hv) ((XPVHV*) SvANY(hv))->xhv_pmroot
#define HvNAME(hv) ((XPVHV*) SvANY(hv))->xhv_name
+#define HvNAME_get(hv) (0 + ((XPVHV*) SvANY(hv))->xhv_name)
+#define HvNAMELEN_get(hv) strlen(HvNAME(hv))
+#define hv_name_set(hv,name,length,flags) \
/* Sadly we can't do this as an LVALUE */
#define HvDATA(hv) ((XPVHV*) SvANY(hv))
@@ -194,6 +206,8 @@
#define HvUSEDKEYS(hv) ((U32)Parrot_PMC_get_intval_intkey(PL_Parrot,MUMBLE(hv), Ponie_I_HV_USEDKEYS))
#define HvTOTALKEYS(hv) (*(IV *)Parrot_PMC_get_pointer_intkey(PL_Parrot,MUMBLE(hv),Ponie_P_HVKEYS))
#define HvPLACEHOLDERS(hv) (*(NV *)Parrot_PMC_get_pointer_intkey(PL_Parrot,MUMBLE(hv),Ponie_P_HVPLACEHOLDERS))
+#define HvPLACEHOLDERS_get(hv) (0 + HvPLACEHOLDERS(hv))
+#define HvPLACEHOLDERS_set(hv, p) (HvPLACEHOLDERS(hv) = (p))
#define HvSHAREKEYS(sv) ((U32)Parrot_PMC_get_intval_intkey(PL_Parrot,MUMBLE(sv), Ponie_I_HV_SHAREKEYS))
#define HvSHAREKEYS_on(sv) Parrot_PMC_set_intval_intkey(PL_Parrot,MUMBLE(sv), Ponie_I_HV_SHAREKEYS, 1)
Modified: branches/5.9.3merge/perl/intrpvar.h
==============================================================================
--- branches/5.9.3merge/perl/intrpvar.h (original)
+++ branches/5.9.3merge/perl/intrpvar.h Thu Mar 16 14:07:54 2006
@@ -249,8 +249,20 @@
PERLVAR(Isighandlerp, Sighandler_t)
-PERLVARA(Ibody_roots, SVt_LAST, void*) /* array of body roots */
-
+PERLVAR(Ixiv_arenaroot, XPV*) /* list of allocated xiv areas */
+PERLVAR(Ixiv_root, IV *) /* free xiv list */
+PERLVAR(Ixnv_root, NV *) /* free xnv list */
+PERLVAR(Ixpv_root, XPV *) /* free xpv list */
+PERLVAR(Ixpviv_root, XPVIV *) /* free xpviv list */
+PERLVAR(Ixpvnv_root, XPVNV *) /* free xpvnv list */
+PERLVAR(Ixpvcv_root, XPVCV *) /* free xpvcv list */
+PERLVAR(Ixpvav_root, XPVAV *) /* free xpvav list */
+PERLVAR(Ixpvhv_root, XPVHV *) /* free xpvhv list */
+PERLVAR(Ixpvmg_root, XPVMG *) /* free xpvmg list */
+PERLVAR(Ixpvlv_root, XPVLV *) /* free xpvlv list */
+PERLVAR(Ixpvbm_root, XPVBM *) /* free xpvbm list */
+PERLVAR(Ihe_root, HE *) /* free he list */
+PERLVAR(Ipte_root, struct ptr_tbl_ent *) /* free ptr_tbl_ent list */
PERLVAR(Inice_chunk, char *) /* a nice chunk of memory to reuse */
PERLVAR(Inice_chunk_size, U32) /* how nice the chunk of memory is */
@@ -419,7 +431,18 @@
#endif
PERLVARI(Ibeginav_save, AV*, NULL) /* save BEGIN{}s when compiling */
-PERLVARA(Ibody_arenaroots, SVt_LAST, void*) /* consolidated body-arena pointers */
+PERLVAR(Ixnv_arenaroot, XPV*) /* list of allocated xnv areas */
+PERLVAR(Ixpv_arenaroot, XPV*) /* list of allocated xpv areas */
+PERLVAR(Ixpviv_arenaroot,XPVIV*) /* list of allocated xpviv areas */
+PERLVAR(Ixpvnv_arenaroot,XPVNV*) /* list of allocated xpvnv areas */
+PERLVAR(Ixpvcv_arenaroot,XPVCV*) /* list of allocated xpvcv areas */
+PERLVAR(Ixpvav_arenaroot,XPVAV*) /* list of allocated xpvav areas */
+PERLVAR(Ixpvhv_arenaroot,XPVHV*) /* list of allocated xpvhv areas */
+PERLVAR(Ixpvmg_arenaroot,XPVMG*) /* list of allocated xpvmg areas */
+PERLVAR(Ixpvlv_arenaroot,XPVLV*) /* list of allocated xpvlv areas */
+PERLVAR(Ixpvbm_arenaroot,XPVBM*) /* list of allocated xpvbm areas */
+PERLVAR(Ihe_arenaroot, XPV*) /* list of allocated he areas */
+PERLVAR(Ipte_arenaroot, XPV*) /* list of allocated he areas */
/* 5.6.0 stopped here */
Modified: branches/5.9.3merge/perl/mg.c
==============================================================================
--- branches/5.9.3merge/perl/mg.c (original)
+++ branches/5.9.3merge/perl/mg.c Thu Mar 16 14:07:54 2006
@@ -441,11 +441,12 @@
mg->mg_ptr, mg->mg_len);
/* container types should remain read-only across localization */
- SvFLAGS(nsv) |= SvREADONLY(sv);
+ if (SvREADONLY(sv))
+ SvREADONLY_on(nsv);
}
if (SvTYPE(nsv) >= SVt_PVMG && SvMAGIC(nsv)) {
- SvFLAGS(nsv) |= SvMAGICAL(sv);
+ SvMAGICAL_set(nsv, SvMAGICAL(sv));
PL_localizing = 1;
SvSETMAGIC(nsv);
PL_localizing = 0;
@@ -2582,6 +2583,7 @@
PL_origargv[0][PL_origalen-1] = 0;
for (i = 1; i < PL_origargc; i++)
PL_origargv[i] = 0;
+ }
UNLOCK_DOLLARZERO_MUTEX;
break;
#endif
@@ -2777,9 +2779,15 @@
sv_force_normal_flags(sv, 0);
#endif
- if (mgs->mgs_flags)
- SvFLAGS(sv) |= mgs->mgs_flags;
- else
+ if (mgs->mgs_flags) {
+ /* SvFLAGS(sv) |= mgs->mgs_flags; */
+ if (mgs->mgs_flags & ~(SVf_READONLY|SVs_GMG|SVs_RMG|SVs_SMG))
+ Perl_croak(aTHX_ "panic: restore_magic flags %08X",
+ mgs->mgs_flags);
+ if (mgs->mgs_flags & SVf_READONLY)
+ SvREADONLY_on(sv);
+ SvMAGICAL_set(sv, mgs->mgs_flags & ~SVf_READONLY);
+ } else
mg_magical(sv);
if (SvGMAGICAL(sv)) {
/* SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); */
Modified: branches/5.9.3merge/perl/op.c
==============================================================================
--- branches/5.9.3merge/perl/op.c (original)
+++ branches/5.9.3merge/perl/op.c Thu Mar 16 14:07:54 2006
@@ -1571,7 +1571,7 @@
/* fake up C<use attributes $pkg,$rv,@attrs> */
ENTER; /* need to protect against side-effects of 'use' */
SAVEINT(PL_expect);
- stashsv = stash ? newSVhek(HvNAME_HEK(stash)) : &PL_sv_no;
+ stashsv = stash ? newSVpv(HvNAME(stash), 0) : &PL_sv_no;
#define ATTRSMODULE "attributes"
#define ATTRSMODULE_PM "attributes.pm"
@@ -1620,7 +1620,7 @@
pack = newSVOP(OP_CONST, 0, newSVpvs(ATTRSMODULE));
/* Build up the real arg-list. */
- stashsv = stash ? newSVhek(HvNAME_HEK(stash)) : &PL_sv_no;
+ stashsv = stash ? newSVpv(HvNAME(stash), 0) : &PL_sv_no;
arg = newOP(OP_PADSV, 0);
arg->op_targ = target->op_targ;
@@ -2838,7 +2838,8 @@
sv_setpvn(pat, "\\s+", 3);
- SvFLAGS(pat) |= was_readonly;
+ if (was_readonly)
+ SvREADONLY_on(pat);
p = SvPV_const(pat, plen);
pm->op_pmflags |= PMf_SKIPWHITE;
@@ -4487,15 +4488,7 @@
ps = SvPVx_const(((SVOP*)proto)->op_sv, ps_len);
}
else
- ps = Nullch;
-
-
- if (proto) {
- assert(proto->op_type == OP_CONST);
- ps = SvPVx(((SVOP*)proto)->op_sv, n_a);
- }
- else
- ps = Nullch;
+ ps = NULL;
if (!name && PERLDB_NAMEANON && CopLINE(PL_curcop)) {
SV * const sv = sv_newmortal();
@@ -5871,7 +5864,6 @@
OP *kid;
const OPCODE type = o->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
I32 offset;
- I32 offset;
o->op_ppaddr = PL_ppaddr[OP_GREPSTART];
NewOp(1101, gwop, 1, LOGOP);
@@ -6248,7 +6240,8 @@
}
}
sv_catpvs(sv, ".pm");
- SvFLAGS(sv) |= was_readonly;
+ if (was_readonly)
+ SvREADONLY_on(sv);
}
}
Modified: branches/5.9.3merge/perl/pad.c
==============================================================================
--- branches/5.9.3merge/perl/pad.c (original)
+++ branches/5.9.3merge/perl/pad.c Thu Mar 16 14:07:54 2006
@@ -444,9 +444,6 @@
retval = PL_padix;
SvPADTMP_on(sv);
}
- else {
- Perl_croak(aTHX_ "panic: pad_alloc called with type %08X", tmptype);
- }
PL_curpad = AvARRAY(PL_comppad);
DEBUG_X(PerlIO_printf(Perl_debug_log,
Modified: branches/5.9.3merge/perl/perl.c
==============================================================================
--- branches/5.9.3merge/perl/perl.c (original)
+++ branches/5.9.3merge/perl/perl.c Thu Mar 16 14:07:54 2006
@@ -1338,13 +1338,6 @@
PerlIO_cleanup(aTHX);
#endif
- /* sv_undef needs to stay immortal until after PerlIO_cleanup
- as currently layers use it rather than Nullsv as a marker
- for no arg - and will try and SvREFCNT_dec it.
- */
- SvREFCNT(&PL_sv_undef) = 0;
- SvREADONLY_off(&PL_sv_undef);
-
Safefree(PL_origfilename);
PL_origfilename = Nullch;
Safefree(PL_reg_start_tmp);
@@ -1391,7 +1384,7 @@
Parrot_unregister_pmc(PL_Parrot, PL_Refcounts);
Parrot_destroy(PL_Parrot);
- return STATUS_NATIVE_EXPORT;
+ return STATUS_EXIT;
}
/*
Modified: branches/5.9.3merge/perl/perlapi.h
==============================================================================
--- branches/5.9.3merge/perl/perlapi.h (original)
+++ branches/5.9.3merge/perl/perlapi.h Thu Mar 16 14:07:54 2006
@@ -184,10 +184,6 @@
#define PL_beginav_save (*Perl_Ibeginav_save_ptr(aTHX))
#undef PL_bitcount
#define PL_bitcount (*Perl_Ibitcount_ptr(aTHX))
-#undef PL_body_arenaroots
-#define PL_body_arenaroots (*Perl_Ibody_arenaroots_ptr(aTHX))
-#undef PL_body_roots
-#define PL_body_roots (*Perl_Ibody_roots_ptr(aTHX))
#undef PL_bufend
#define PL_bufend (*Perl_Ibufend_ptr(aTHX))
#undef PL_bufptr
@@ -316,6 +312,10 @@
#define PL_hash_seed (*Perl_Ihash_seed_ptr(aTHX))
#undef PL_hash_seed_set
#define PL_hash_seed_set (*Perl_Ihash_seed_set_ptr(aTHX))
+#undef PL_he_arenaroot
+#define PL_he_arenaroot (*Perl_Ihe_arenaroot_ptr(aTHX))
+#undef PL_he_root
+#define PL_he_root (*Perl_Ihe_root_ptr(aTHX))
#undef PL_hintgv
#define PL_hintgv (*Perl_Ihintgv_ptr(aTHX))
#undef PL_hints
@@ -596,8 +596,8 @@
#define PL_subname (*Perl_Isubname_ptr(aTHX))
#undef PL_suidscript
#define PL_suidscript (*Perl_Isuidscript_ptr(aTHX))
-#undef PL_sv_arenaroot
-#define PL_sv_arenaroot (*Perl_Isv_arenaroot_ptr(aTHX))
+#undef PL_sv_arenatable
+#define PL_sv_arenatable (*Perl_Isv_arenatable_ptr(aTHX))
#undef PL_sv_count
#define PL_sv_count (*Perl_Isv_count_ptr(aTHX))
#undef PL_sv_no_p
@@ -678,6 +678,50 @@
#define PL_warnhook (*Perl_Iwarnhook_ptr(aTHX))
#undef PL_widesyscalls
#define PL_widesyscalls (*Perl_Iwidesyscalls_ptr(aTHX))
+#undef PL_xiv_arenaroot
+#define PL_xiv_arenaroot (*Perl_Ixiv_arenaroot_ptr(aTHX))
+#undef PL_xiv_root
+#define PL_xiv_root (*Perl_Ixiv_root_ptr(aTHX))
+#undef PL_xnv_arenaroot
+#define PL_xnv_arenaroot (*Perl_Ixnv_arenaroot_ptr(aTHX))
+#undef PL_xnv_root
+#define PL_xnv_root (*Perl_Ixnv_root_ptr(aTHX))
+#undef PL_xpv_arenaroot
+#define PL_xpv_arenaroot (*Perl_Ixpv_arenaroot_ptr(aTHX))
+#undef PL_xpv_root
+#define PL_xpv_root (*Perl_Ixpv_root_ptr(aTHX))
+#undef PL_xpvav_arenaroot
+#define PL_xpvav_arenaroot (*Perl_Ixpvav_arenaroot_ptr(aTHX))
+#undef PL_xpvav_root
+#define PL_xpvav_root (*Perl_Ixpvav_root_ptr(aTHX))
+#undef PL_xpvbm_arenaroot
+#define PL_xpvbm_arenaroot (*Perl_Ixpvbm_arenaroot_ptr(aTHX))
+#undef PL_xpvbm_root
+#define PL_xpvbm_root (*Perl_Ixpvbm_root_ptr(aTHX))
+#undef PL_xpvcv_arenaroot
+#define PL_xpvcv_arenaroot (*Perl_Ixpvcv_arenaroot_ptr(aTHX))
+#undef PL_xpvcv_root
+#define PL_xpvcv_root (*Perl_Ixpvcv_root_ptr(aTHX))
+#undef PL_xpvhv_arenaroot
+#define PL_xpvhv_arenaroot (*Perl_Ixpvhv_arenaroot_ptr(aTHX))
+#undef PL_xpvhv_root
+#define PL_xpvhv_root (*Perl_Ixpvhv_root_ptr(aTHX))
+#undef PL_xpviv_arenaroot
+#define PL_xpviv_arenaroot (*Perl_Ixpviv_arenaroot_ptr(aTHX))
+#undef PL_xpviv_root
+#define PL_xpviv_root (*Perl_Ixpviv_root_ptr(aTHX))
+#undef PL_xpvlv_arenaroot
+#define PL_xpvlv_arenaroot (*Perl_Ixpvlv_arenaroot_ptr(aTHX))
+#undef PL_xpvlv_root
+#define PL_xpvlv_root (*Perl_Ixpvlv_root_ptr(aTHX))
+#undef PL_xpvmg_arenaroot
+#define PL_xpvmg_arenaroot (*Perl_Ixpvmg_arenaroot_ptr(aTHX))
+#undef PL_xpvmg_root
+#define PL_xpvmg_root (*Perl_Ixpvmg_root_ptr(aTHX))
+#undef PL_xpvnv_arenaroot
+#define PL_xpvnv_arenaroot (*Perl_Ixpvnv_arenaroot_ptr(aTHX))
+#undef PL_xpvnv_root
+#define PL_xpvnv_root (*Perl_Ixpvnv_root_ptr(aTHX))
#undef PL_yycharp
#define PL_yycharp (*Perl_Iyycharp_ptr(aTHX))
#undef PL_yylvalp
@@ -956,6 +1000,14 @@
#define PL_perlio_debug_fd (*Perl_Gperlio_debug_fd_ptr(NULL))
#undef PL_perlio_fd_refcnt
#define PL_perlio_fd_refcnt (*Perl_Gperlio_fd_refcnt_ptr(NULL))
+#undef PL_pmc_to_type
+#define PL_pmc_to_type (*Perl_Gpmc_to_type_ptr(NULL))
+#undef PL_pmc_to_type_max
+#define PL_pmc_to_type_max (*Perl_Gpmc_to_type_max_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_ppaddr
#define PL_ppaddr (*Perl_Gppaddr_ptr(NULL))
#undef PL_sh_path
Modified: branches/5.9.3merge/perl/proto.h
==============================================================================
--- branches/5.9.3merge/perl/proto.h (original)
+++ branches/5.9.3merge/perl/proto.h Thu Mar 16 14:07:54 2006
@@ -2043,6 +2043,12 @@
__attribute__nonnull__(pTHX_1);
PERL_CALLCONV SV* Perl_sv_2mortal(pTHX_ SV* sv);
+#if defined(PERL_CORE) || defined(PONIE_CORE)
+PERL_CALLCONV IV Perl_sv_2iv_backend(pTHX_ SV* sv, I32 flags);
+PERL_CALLCONV UV Perl_sv_2uv_backend(pTHX_ SV* sv, I32 flags);
+PERL_CALLCONV NV Perl_sv_2nv_backend(pTHX_ SV* sv);
+PERL_CALLCONV char* Perl_sv_2pv_backend(pTHX_ SV* sv, STRLEN* lp, I32 flags);
+#endif
PERL_CALLCONV NV Perl_sv_2nv(pTHX_ SV* sv)
__attribute__nonnull__(pTHX_1);
@@ -2127,6 +2133,7 @@
PERL_CALLCONV void Perl_sv_clear(pTHX_ SV* sv)
__attribute__nonnull__(pTHX_1);
+PERL_CALLCONV void Perl_sv_clear_backend(pTHX_ SV* sv, I32 flags);
PERL_CALLCONV I32 Perl_sv_cmp(pTHX_ SV* sv1, SV* sv2)
__attribute__nonnull__(pTHX_1)
__attribute__nonnull__(pTHX_2);
@@ -2238,6 +2245,11 @@
__attribute__nonnull__(pTHX_2);
PERL_CALLCONV void Perl_sv_report_used(pTHX);
+#if defined(PERL_CORE) || defined(PONIE_CORE)
+PERL_CALLCONV void Perl_sv_setnv_backend(pTHX_ SV* sv, NV num, I32 flags);
+PERL_CALLCONV void Perl_sv_setiv_backend(pTHX_ SV* sv, UV num, I32 flags);
+PERL_CALLCONV void Perl_sv_setpvn_backend(pTHX_ SV* sv, const char* ptr, STRLEN len, I32 flags);
+#endif
PERL_CALLCONV void Perl_sv_reset(pTHX_ const char* s, HV* stash)
__attribute__nonnull__(pTHX_1);
@@ -2787,6 +2799,16 @@
# endif
#endif
+PERL_CALLCONV PTR_TBL_t* Perl_ptr_table_new(pTHX);
+PERL_CALLCONV bool Perl_ptr_table_delete(pTHX_ PTR_TBL_t *tbl, void *sv);
+PERL_CALLCONV void* Perl_ptr_table_fetch(pTHX_ PTR_TBL_t *tbl, void *sv);
+PERL_CALLCONV void Perl_ptr_table_store(pTHX_ PTR_TBL_t *tbl, void *oldsv, void *newsv);
+PERL_CALLCONV void Perl_ptr_table_inc(pTHX_ PTR_TBL_t *tbl, void *oldv);
+PERL_CALLCONV void Perl_ptr_table_dec(pTHX_ PTR_TBL_t *tbl, void *oldv);
+PERL_CALLCONV U32 Perl_ptr_table_val(pTHX_ PTR_TBL_t *tbl, void *sv);
+PERL_CALLCONV void Perl_ptr_table_split(pTHX_ PTR_TBL_t *tbl);
+PERL_CALLCONV void Perl_ptr_table_clear(pTHX_ PTR_TBL_t *tbl);
+PERL_CALLCONV void Perl_ptr_table_free(pTHX_ PTR_TBL_t *tbl);
#if defined(HAVE_INTERP_INTERN)
PERL_CALLCONV void Perl_sys_intern_clear(pTHX);
PERL_CALLCONV void Perl_sys_intern_init(pTHX);
@@ -2812,6 +2834,10 @@
/* PERL_CALLCONV void Perl_sv_nounlocking(pTHX_ SV *sv); */
PERL_CALLCONV int Perl_nothreadhook(pTHX);
+#if defined(PERL_IN_GV_C) || defined(PERL_IN_SV_C) || defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT)
+PERL_CALLCONV void Perl_sv_add_backref(pTHX_ SV *tsv, SV *sv);
+#endif
+
END_EXTERN_C
#if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT)
@@ -2857,10 +2883,9 @@
STATIC void S_hfreeentries(pTHX_ HV *hv)
__attribute__nonnull__(pTHX_1);
-STATIC HE* S_new_he(pTHX)
- __attribute__malloc__
- __attribute__warn_unused_result__;
-
+STATIC void S_more_he(pTHX);
+STATIC HE* S_new_he(pTHX);
+STATIC void S_del_he(pTHX_ HE *p);
STATIC HEK* S_save_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags)
__attribute__malloc__
__attribute__warn_unused_result__
@@ -2881,9 +2906,6 @@
__attribute__nonnull__(pTHX_2)
__attribute__nonnull__(pTHX_4);
-STATIC struct xpvhv_aux* S_hv_auxinit(pTHX_ HV *hv)
- __attribute__nonnull__(pTHX_1);
-
STATIC SV* S_hv_delete_common(pTHX_ HV* tb, SV* keysv, const char* key, STRLEN klen, int k_flags, I32 d_flags, U32 hash);
STATIC HE* S_hv_fetch_common(pTHX_ HV* tb, SV* keysv, const char* key, STRLEN klen, int flags, int action, SV* val, U32 hash);
#endif
@@ -3552,8 +3574,6 @@
__attribute__nonnull__(pTHX_4)
__attribute__nonnull__(pTHX_5);
-
-STATIC I32 S_make_trie(pTHX_ struct RExC_state_t*, regnode *startbranch, regnode *first, regnode *last, regnode *tail, U32 flags);
#endif
#if defined(PERL_IN_REGEXEC_C) || defined(PERL_DECL_PROT)
@@ -3653,27 +3673,15 @@
__attribute__nonnull__(1)
__attribute__nonnull__(5);
-STATIC void S_sv_unglob(pTHX_ SV* sv)
- __attribute__nonnull__(pTHX_1);
-
STATIC void S_not_a_number(pTHX_ SV *sv)
__attribute__nonnull__(pTHX_1);
STATIC I32 S_visit(pTHX_ SVFUNC_t f, U32 flags, U32 mask)
__attribute__nonnull__(pTHX_1);
-STATIC void S_sv_del_backref(pTHX_ SV *target, SV *ref)
- __attribute__nonnull__(pTHX_1)
- __attribute__nonnull__(pTHX_2);
-
STATIC SV * S_varname(pTHX_ GV *gv, const char gvtype, PADOFFSET targ, SV *keyname, I32 aindex, int subscript_type)
__attribute__warn_unused_result__;
-# ifdef DEBUGGING
-STATIC void S_del_sv(pTHX_ SV *p)
- __attribute__nonnull__(pTHX_1);
-
-# endif
# if !defined(NV_PRESERVES_UV)
STATIC int S_sv_2iuv_non_preserve(pTHX_ SV *sv, I32 numtype)
__attribute__nonnull__(pTHX_1);
@@ -4046,18 +4054,16 @@
#endif
PERL_CALLCONV void Perl_save_set_svflags(pTHX_ SV* sv, U32 mask, U32 val);
+PERL_CALLCONV void Perl_save_set_padstale(pTHX_ SV* sv);
PERL_CALLCONV void Perl_hv_assert(pTHX_ HV* tb)
__attribute__nonnull__(pTHX_1);
-#if defined(PERL_IN_HV_C) || defined(PERL_DECL_PROT)
-STATIC SV* S_hv_delete_common(pTHX_ HV* tb, SV* key_sv, const char* key, STRLEN klen, int k_flags, I32 d_flags, U32 hash);
-STATIC HE* S_hv_fetch_common(pTHX_ HV* tb, SV* key_sv, const char* key, STRLEN klen, int flags, int action, SV* val, U32 hash);
-#endif
PERL_CALLCONV SV* Perl_hv_scalar(pTHX_ HV* hv)
__attribute__warn_unused_result__
__attribute__nonnull__(pTHX_1);
+#ifdef NOT_YET
PERL_CALLCONV I32* Perl_hv_riter_p(pTHX_ HV* hv)
__attribute__warn_unused_result__
__attribute__nonnull__(pTHX_1);
@@ -4078,6 +4084,7 @@
PERL_CALLCONV AV** Perl_hv_backreferences_p(pTHX_ HV* hv)
__attribute__nonnull__(pTHX_1);
+#endif
#if defined(PERL_IN_DUMP_C) || defined(PERL_IN_HV_C) || defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT)
PERL_CALLCONV void Perl_hv_kill_backrefs(pTHX_ HV* hv)
__attribute__nonnull__(pTHX_1);
@@ -4086,6 +4093,7 @@
PERL_CALLCONV void Perl_hv_clear_placeholders(pTHX_ HV* hb)
__attribute__nonnull__(pTHX_1);
+#if 0
PERL_CALLCONV I32* Perl_hv_placeholders_p(pTHX_ HV* hv)
__attribute__warn_unused_result__
__attribute__nonnull__(pTHX_1);
@@ -4097,6 +4105,7 @@
PERL_CALLCONV void Perl_hv_placeholders_set(pTHX_ HV* hv, I32 ph)
__attribute__nonnull__(pTHX_1);
+#endif
PERL_CALLCONV SV* Perl_magic_scalarpack(pTHX_ HV* hv, MAGIC* mg)
__attribute__nonnull__(pTHX_1)
@@ -4234,6 +4243,15 @@
#endif
+#if defined(PERL_CORE) || defined(PONIE_CORE)
+PERL_CALLCONV IV Perl_sv_2iv_backend(pTHX_ SV* sv, I32 flags);
+PERL_CALLCONV UV Perl_sv_2uv_backend(pTHX_ SV* sv, I32 flags);
+PERL_CALLCONV NV Perl_sv_2nv_backend(pTHX_ SV* sv);
+PERL_CALLCONV char* Perl_sv_2pv_backend(pTHX_ SV* sv, STRLEN* lp, I32 flags);
+PERL_CALLCONV void Perl_sv_setnv_backend(pTHX_ SV* sv, NV num, I32 flags);
+PERL_CALLCONV void Perl_sv_setiv_backend(pTHX_ SV* sv, UV num, I32 flags);
+PERL_CALLCONV void Perl_sv_setpvn_backend(pTHX_ SV* sv, const char* ptr, STRLEN len, I32 flags);
+#endif
END_EXTERN_C
/*
Modified: branches/5.9.3merge/perl/sv.h
==============================================================================
--- branches/5.9.3merge/perl/sv.h (original)
+++ branches/5.9.3merge/perl/sv.h Thu Mar 16 14:07:54 2006
@@ -63,36 +63,8 @@
SVt_MAX
} svtype;
-#ifdef PERL_IN_SV_C
-#define PTE_SVSLOT SVt_RV
-#endif
-#if defined(PERL_IN_HV_C) || defined(PERL_IN_XS_APITEST)
-#define HE_SVSLOT SVt_NULL
-#endif
-
-/* typedefs to eliminate some typing */
-typedef struct he HE;
-typedef struct hek HEK;
-
/* Using C's structural equivalence to help emulate C++ inheritance here... */
-/* start with 2 sv-head building blocks */
-#define _SV_HEAD(ptrtype) \
- ptrtype sv_any; /* pointer to body */ \
- U32 sv_refcnt; /* how many references to us */ \
- U32 sv_flags /* what we are */
-
-#define _SV_HEAD_UNION \
- union { \
- IV svu_iv; \
- UV svu_uv; \
- SV* svu_rv; /* pointer to another SV */ \
- char* svu_pv; /* pointer to malloced string */ \
- SV** svu_array; \
- HE** svu_hash; \
- } sv_u
-
-
struct STRUCT_SV { /* struct sv { */
void* sv_any; /* pointer to something */
U32 sv_flags; /* what we are */
@@ -345,9 +317,9 @@
/* Sadly there are some parts of the core that have pointers to already-freed
SV heads, and rely on being able to tell that they are now free. So mark
them all by using a consistent macro. */
-#define SvIS_FREED(sv) ((sv)->sv_flags == SVTYPEMASK)
+#define SvIS_FREED(sv) Parrot_PMC_get_intval_intkey(PL_Parrot, MUMBLE(sv), \
+ Ponie_I_SV_TYPE_IS_MASK_NO_ABORT)
-/* #define SvUPGRADE(sv, mt) (SvTYPE(sv) >= (mt) || (sv_upgrade(sv, mt), 1)) */
typedef enum {
Ponie_N_SV_NV_NO_GMAGIC,
Ponie_N_MAX
@@ -375,10 +347,7 @@
#define SVf_ROK 0x00080000 /* has a valid reference pointer */
#define SVf_FAKE 0x00100000 /* glob or lexical is just a copy */
-#define SVf_OOK 0x00200000 /* has valid offset value
- For a PVHV this means that a
- hv_aux struct is present after the
- main array */
+#define SVf_OOK 0x00200000 /* has valid offset value */
#define SVf_BREAK 0x00400000 /* refcnt is artificially low - used
* by SV's in final arena cleanup */
#define SVf_READONLY 0x00800000 /* may not be modified */
@@ -963,6 +932,9 @@
#define SvSTASH(sv) (*(HV **)Parrot_PMC_get_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_STASH))
#endif
+/* These ought to become distinct calls into the PMCs */
+#define SvPVX_mutable(sv) SvPVX(sv)
+#define SvPVX_const(sv) ((const char*)SvPVX(sv))
#define SvRVx(sv) SvRV(sv)
#define SvIVXx(sv) SvIVX(sv)
#define SvUVXx(sv) SvUVX(sv)
Modified: branches/5.9.3merge/perl/toke.c
==============================================================================
--- branches/5.9.3merge/perl/toke.c (original)
+++ branches/5.9.3merge/perl/toke.c Thu Mar 16 14:07:54 2006
@@ -4529,7 +4529,7 @@
case KEY___PACKAGE__:
yylval.opval = (OP*)newSVOP(OP_CONST, 0,
(PL_curstash
- ? newSVhek(HvNAME_HEK(PL_curstash))
+ ? newSVpv(HvNAME(PL_curstash), 0)
: &PL_sv_undef));
TERM(THING);
@@ -5754,9 +5754,7 @@
/* might be an "our" variable" */
if (PAD_COMPNAME_FLAGS(tmp) & SVpad_OUR) {
/* build ops for a bareword */
- HV * const stash = PAD_COMPNAME_OURSTASH(tmp);
- HEK * const stashname = HvNAME_HEK(stash);
- SV * const sym = newSVhek(stashname);
+ SV *sym = newSVpv(HvNAME(PAD_COMPNAME_OURSTASH(tmp)), 0);
sv_catpvs(sym, "::");
sv_catpv(sym, PL_tokenbuf+1);
yylval.opval = (OP*)newSVOP(OP_CONST, 0, sym);
@@ -10039,9 +10037,8 @@
*/
if ((tmp = pad_findmy(d)) != NOT_IN_PAD) {
if (PAD_COMPNAME_FLAGS(tmp) & SVpad_OUR) {
- HV * const stash = PAD_COMPNAME_OURSTASH(tmp);
- HEK * const stashname = HvNAME_HEK(stash);
- SV * const sym = sv_2mortal(newSVhek(stashname));
+ SV *sym = sv_2mortal(
+ newSVpv(HvNAME(PAD_COMPNAME_OURSTASH(tmp)),0));
sv_catpvs(sym, "::");
sv_catpv(sym, d+1);
d = SvPVX(sym);