Front page | perl.ponie.changes |
Postings from March 2006
[svn:ponie] r396 - branches/5.9.3merge/perl
From:
nicholas
Date:
March 16, 2006 15:53
Subject:
[svn:ponie] r396 - branches/5.9.3merge/perl
Message ID:
20060316235343.A2CD5CBA2B@x12.develooper.com
Author: nicholas
Date: Thu Mar 16 15:53:42 2006
New Revision: 396
Modified:
branches/5.9.3merge/perl/embed.fnc
branches/5.9.3merge/perl/embed.h
branches/5.9.3merge/perl/perlio.c
branches/5.9.3merge/perl/pp.c
branches/5.9.3merge/perl/pp_hot.c
branches/5.9.3merge/perl/pp_pack.c
branches/5.9.3merge/perl/proto.h
branches/5.9.3merge/perl/regexec.c
branches/5.9.3merge/perl/sv.c
branches/5.9.3merge/perl/sv.h
Log:
Fix the remainder of the compile errors. This gets us to the point of linking a
miniperl. Of course, it doesn't actually run properly yet. :-)
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 15:53:42 2006
@@ -1339,6 +1339,7 @@
nsR |char * |uiv_2buf |NN char *buf|IV iv|UV uv|int is_uv|NN char **peob
s |void |not_a_number |NN SV *sv
s |I32 |visit |NN SVFUNC_t f|U32 flags|U32 mask
+p |void |sv_del_backref |SV *target|SV *ref
sR |SV * |varname |NULLOK GV *gv|const char gvtype|PADOFFSET targ \
|NULLOK SV *keyname|I32 aindex|int subscript_type
# if !defined(NV_PRESERVES_UV)
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 15:53:42 2006
@@ -1353,6 +1353,7 @@
#define uiv_2buf S_uiv_2buf
#define not_a_number S_not_a_number
#define visit S_visit
+#define sv_del_backref Perl_sv_del_backref
#define varname S_varname
#endif
# if !defined(NV_PRESERVES_UV)
@@ -3420,6 +3421,7 @@
#define uiv_2buf S_uiv_2buf
#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) Perl_sv_del_backref(aTHX_ a,b)
#define varname(a,b,c,d,e,f) S_varname(aTHX_ a,b,c,d,e,f)
#endif
# if !defined(NV_PRESERVES_UV)
Modified: branches/5.9.3merge/perl/perlio.c
==============================================================================
--- branches/5.9.3merge/perl/perlio.c (original)
+++ branches/5.9.3merge/perl/perlio.c Thu Mar 16 15:53:42 2006
@@ -470,7 +470,6 @@
}
if (PL_perlio_debug_fd > 0) {
dTHX;
- const char *s;
#ifdef USE_ITHREADS
const char * const s = CopFILE(PL_curcop);
/* Use fixed buffer as sv_catpvf etc. needs SVs */
Modified: branches/5.9.3merge/perl/pp.c
==============================================================================
--- branches/5.9.3merge/perl/pp.c (original)
+++ branches/5.9.3merge/perl/pp.c Thu Mar 16 15:53:42 2006
@@ -600,9 +600,8 @@
break;
case 'P':
if (strEQ(second_letter, "ACKAGE")) {
- const HV * const stash = GvSTASH(gv);
- const HEK * const hek = stash ? HvNAME_HEK(stash) : NULL;
- sv = hek ? newSVhek(hek) : newSVpvs("__ANON__");
+ const char *name = HvNAME(GvSTASH(gv));
+ sv = newSVpv(name ? name : "__ANON__", 0);
}
break;
case 'S':
Modified: branches/5.9.3merge/perl/pp_hot.c
==============================================================================
--- branches/5.9.3merge/perl/pp_hot.c (original)
+++ branches/5.9.3merge/perl/pp_hot.c Thu Mar 16 15:53:42 2006
@@ -378,7 +378,9 @@
&& SvIVX(TOPs) != IV_MAX)
{
SvIV_set(TOPs, SvIVX(TOPs) + 1);
- SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
+ /*SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);*/
+ SvPOK_off(TOPs);
+ SvNOK_off(TOPs);
}
else /* Do all the PERL_PRESERVE_IVUV conditionals in sv_inc */
sv_inc(TOPs);
@@ -3163,18 +3165,10 @@
packname = CopSTASHPV(PL_curcop);
}
else if (stash) {
- HEK * const packhek = HvNAME_HEK(stash);
- if (packhek) {
- packname = HEK_KEY(packhek);
- packlen = HEK_LEN(packhek);
- need_strlen = 0;
- } else {
- goto croak;
- }
+ packname = HvNAME(stash);
}
if (!packname) {
- croak:
Perl_croak(aTHX_
"Can't use anonymous symbol table for method lookup");
}
Modified: branches/5.9.3merge/perl/pp_pack.c
==============================================================================
--- branches/5.9.3merge/perl/pp_pack.c (original)
+++ branches/5.9.3merge/perl/pp_pack.c Thu Mar 16 15:53:42 2006
@@ -2495,7 +2495,7 @@
from_start -= SvIVX(sv);
SvIV_set(sv, 0);
}
- SvFLAGS(sv) &= ~SVf_OOK;
+ Parrot_PMC_set_intval_intkey(PL_Parrot,MUMBLE(sv), Ponie_I_SVf_OOK, 0);
}
if (SvLEN(sv) != 0)
Safefree(from_start);
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 15:53:42 2006
@@ -3679,6 +3679,7 @@
STATIC I32 S_visit(pTHX_ SVFUNC_t f, U32 flags, U32 mask)
__attribute__nonnull__(pTHX_1);
+PERL_CALLCONV void Perl_sv_del_backref(pTHX_ SV *target, SV *ref);
STATIC SV * S_varname(pTHX_ GV *gv, const char gvtype, PADOFFSET targ, SV *keyname, I32 aindex, int subscript_type)
__attribute__warn_unused_result__;
Modified: branches/5.9.3merge/perl/regexec.c
==============================================================================
--- branches/5.9.3merge/perl/regexec.c (original)
+++ branches/5.9.3merge/perl/regexec.c Thu Mar 16 15:53:42 2006
@@ -1636,7 +1636,6 @@
SV* oreplsv = GvSV(PL_replgv);
const bool do_utf8 = DO_UTF8(sv);
const I32 multiline = prog->reganch & PMf_MULTILINE;
- I32 multiline = prog->reganch & PMf_MULTILINE;
#ifdef DEBUGGING
SV * const dsv0 = PERL_DEBUG_PAD_ZERO(0);
SV * const dsv1 = PERL_DEBUG_PAD_ZERO(1);
@@ -2409,7 +2408,6 @@
SV *re_debug_flags = NULL;
- SV *re_debug_flags;
#endif
U32 uniflags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
@@ -3484,7 +3482,6 @@
CURCUR* cc = PL_regcc;
char * const lastloc = cc->lastloc; /* Detection of 0-len. */
I32 cache_offset = 0, cache_bit = 0;
- I32 cache_offset = 0, cache_bit = 0;
n = cc->cur + 1; /* how many we know we matched */
PL_reginput = locinput;
Modified: branches/5.9.3merge/perl/sv.c
==============================================================================
--- branches/5.9.3merge/perl/sv.c (original)
+++ branches/5.9.3merge/perl/sv.c Thu Mar 16 15:53:42 2006
@@ -597,50 +597,22 @@
Parrot_unregister_pmc(PL_Parrot, PL_sv_pining);
}
+/*
+=for apidoc sv_upgrade
-
-
-
-
-
-}
-
-
-
-
-
-
-
-
-
+Upgrade an SV to a more complex form. Generally adds a new body type to the
+SV, then copies across as much information as possible from the old body.
+You generally want to use the C<SvUPGRADE> macro wrapper. See also C<svtype>.
=cut
*/
+void
+Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
{
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- break;
- break;
- break;
- break;
- break;
- break;
- break;
-
- break;
+ Parrot_PMC_set_intval_intkey(PL_Parrot,MUMBLE(sv), Ponie_I_SV_UPGRADE_func,
+ mt);
+}
/*
=for apidoc sv_backoff
@@ -1384,7 +1356,7 @@
/* The code that the PMC calls back to (for now). */
IV
-Perl_sv_2iv_flags(pTHX_ register SV *sv, I32 flags)
+Perl_sv_2iv_backend(pTHX_ register SV *sv, I32 flags)
{
dVAR;
if (!sv)
@@ -1464,7 +1436,7 @@
*/
UV
-Perl_sv_2uv_flags(pTHX_ register SV *sv, I32 flags)
+Perl_sv_2uv_backend(pTHX_ register SV *sv, I32 flags)
{
dVAR;
if (!sv)
@@ -1815,70 +1787,6 @@
return getlen.pv;
}
-/* asIV(): extract an integer from the string value of an SV.
- * Caller must validate PVX */
-
-STATIC IV
-S_asIV(pTHX_ SV *sv)
-{
- UV value;
- int numtype = grok_number(SvPVX(sv), SvCUR(sv), &value);
-
- if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT))
- == IS_NUMBER_IN_UV) {
- /* It's definitely an integer */
- if (numtype & IS_NUMBER_NEG) {
- if (value < (UV)IV_MIN)
- return -(IV)value;
- } else {
- if (value < (UV)IV_MAX)
- return (IV)value;
- }
- }
- if (!numtype) {
- if (ckWARN(WARN_NUMERIC))
- not_a_number(sv);
- }
- return I_V(Atof(SvPVX(sv)));
-}
-
-/* asUV(): extract an unsigned integer from the string value of an SV
- * Caller must validate PVX */
-
-STATIC UV
-S_asUV(pTHX_ SV *sv)
-{
- UV value;
- int numtype = grok_number(SvPVX(sv), SvCUR(sv), &value);
-
- if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT))
- == IS_NUMBER_IN_UV) {
- /* It's definitely an integer */
- if (!(numtype & IS_NUMBER_NEG))
- return value;
- }
- if (!numtype) {
- if (ckWARN(WARN_NUMERIC))
- not_a_number(sv);
- }
- return U_V(Atof(SvPVX(sv)));
-}
-
-/*
-=for apidoc sv_2pv_nolen
-
-Like C<sv_2pv()>, but doesn't return the length too. You should usually
-use the macro wrapper C<SvPV_nolen(sv)> instead.
-=cut
-*/
-
-char *
-Perl_sv_2pv_nolen(pTHX_ register SV *sv)
-{
- STRLEN n_a;
- return sv_2pv(sv, &n_a);
-}
-
/* uiv_2buf(): private routine for use by sv_2pv_flags(): print an IV or
* UV as a string towards the end of buf, and return pointers to start and
* end of it.
@@ -3480,22 +3388,6 @@
}
/*
-=for apidoc sv_force_normal
-
-Undo various types of fakery on an SV: if the PV is a shared string, make
-a private copy; if we're a ref, stop refing; if we're a glob, downgrade to
-an xpvmg. See also C<sv_force_normal_flags>.
-
-=cut
-*/
-
-void
-Perl_sv_force_normal(pTHX_ register SV *sv)
-{
- sv_force_normal_flags(sv, 0);
-}
-
-/*
=for apidoc sv_chop
Efficient removal of characters from the beginning of the string buffer.
@@ -3730,7 +3622,7 @@
=cut
*/
MAGIC *
-Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, const MGVTBL *vtable,
+Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, MGVTBL *vtable,
const char* name, I32 namlen)
{
dVAR;
@@ -8641,7 +8533,7 @@
register struct ptr_tbl_ent* pte;
register struct ptr_tbl_ent* pteend;
XPV *ptr;
- New(54, ptr, PERL_ARENA_SIZE/sizeof(XPV), XPV);
+ Newx(ptr, PERL_ARENA_SIZE/sizeof(XPV), XPV);
ptr->xpv_pv = (char*)PL_pte_arenaroot;
PL_pte_arenaroot = ptr;
@@ -8893,6 +8785,7 @@
Safefree(tbl);
}
+#ifdef USE_ITHREADS
void
Perl_rvpv_dup(pTHX_ SV *dstr, const SV *sstr, CLONE_PARAMS* param)
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 15:53:42 2006
@@ -982,6 +982,22 @@
const STRLEN _lEnGtH = SvCUR(sv) + 1; \
SvPV_renew(sv, _lEnGtH); \
} STMT_END
+/* FIXME - this should be moved inside the PMC code.
+ Heck, or this should just eliminated when C strings go. */
+#define SvPV_free(sv) \
+ STMT_START { \
+ assert(SvTYPE(sv) >= SVt_PV); \
+ if (SvLEN(sv)) { \
+ if(SvOOK(sv)) { \
+ SvPV_set(sv, SvPVX_mutable(sv) - SvIVX(sv)); \
+ Parrot_PMC_set_intval_intkey(PL_Parrot, \
+ MUMBLE(sv), \
+ Ponie_I_SVf_OOK, \
+ 0); \
+ } \
+ Safefree(SvPVX(sv)); \
+ } \
+ } STMT_END
#define BmRARE(sv) (*(U8 *)Parrot_PMC_get_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RARE))
#define BmUSEFUL(sv) (*(I32 *)Parrot_PMC_get_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_USEFUL))
-
[svn:ponie] r396 - branches/5.9.3merge/perl
by nicholas